Статьи

R: Векторизация всех вещей

Декабрь 5, 2018

После моего последнего поста о поиске расстояния дата / время от выходных, Хэдли Уикхем предложил мне улучшить функцию, векторизовав ее…

… Поэтому я решил попробовать векторизовать некоторые другие функции, которые я написал недавно, и показать две версии.

Я нашел следующие статьи полезными для объяснения векторизации и почему вы можете захотеть сделать это:

Давайте начнем.

Расстояние от выходных

Мы хотим выяснить, сколько часов до выходных, т.е. ближайшей субботы / воскресенья, является конкретная дата / время. Мы будем использовать следующие библиотеки и набор даты / времени:

1
2
3
4
5
6
7
library(dplyr)
library(lubridate)
library(geosphere)
options("scipen"=100, "digits"=4)
  
times = ymd_hms("2002-01-01 17:00:00") + c(0:99) * hours(1)
data = data.frame(time = times)
1
2
3
4
5
6
7
8
> data %>% head()
                 time
1 2002-01-01 17:00:00
2 2002-01-01 18:00:00
3 2002-01-01 19:00:00
4 2002-01-01 20:00:00
5 2002-01-01 21:00:00
6 2002-01-01 22:00:00

Давайте сначала посмотрим на не векторизованную версию:

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
distanceFromWeekend = function(dateToLookup) {
  before = floor_date(dateToLookup, "week") + hours(23) + minutes(59) + seconds(59)
  after  = ceiling_date(dateToLookup, "week") - days(1)
  timeToBefore = dateToLookup - before
  timeToAfter = after - dateToLookup
  
  if(timeToBefore < 0 || timeToAfter < 0) {
    0 
  } else {
    if(timeToBefore < timeToAfter) {
      timeToBefore / dhours(1)
    } else {
      timeToAfter / dhours(1)
    }
  }
}

Теперь давайте запустим его для нашего фрейма данных:

1
2
3
4
5
> system.time(
    data %>% mutate(ind = row_number()) %>% group_by(ind) %>% mutate(dist = distanceFromWeekend(time)) 
    )
   user  system elapsed
  1.837   0.020   1.884

А теперь для векторизованной версии Хэдли:

1
2
3
4
5
6
7
8
9
distanceFromWeekendVectorised = function(dateToLookup) {
  before = floor_date(dateToLookup, "week") + hours(23) + minutes(59) + seconds(59)
  after  = ceiling_date(dateToLookup, "week") - days(1)
  pmin(pmax(dateToLookup - before, 0), pmax(after - dateToLookup, 0)) / dhours(1)
}
  
> system.time(data %>% mutate(dist = distanceFromWeekendVectorised(time)))
   user  system elapsed
  0.020   0.001   0.023

Извлечение даты начала

Мой следующий пример — очистка данных Google Trends и извлечение даты начала из ячейки в файле CSV.

Мы будем использовать этот фрейм данных:

1
2
googleTrends = read.csv("/Users/markneedham/Downloads/report.csv", row.names=NULL)
names(googleTrends) = c("week", "score")
01
02
03
04
05
06
07
08
09
10
11
12
> googleTrends %>% head(10)
                        week score
1  Worldwide; 2004 - present     
2         Interest over time     
3                       Week neo4j
4    2004-01-04 - 2004-01-10     0
5    2004-01-11 - 2004-01-17     0
6    2004-01-18 - 2004-01-24     0
7    2004-01-25 - 2004-01-31     0
8    2004-02-01 - 2004-02-07     0
9    2004-02-08 - 2004-02-14     0
10   2004-02-15 - 2004-02-21     0

Не векторизованная версия выглядела так:

1
2
3
4
5
6
7
8
9
> system.time(
    googleTrends %>%
      mutate(ind = row_number()) %>%
      group_by(ind) %>%
      mutate(dates = strsplit(week, " - "),
             start = dates[[1]][1] %>% strptime("%Y-%m-%d") %>% as.character())
    )
   user  system elapsed
  0.215   0.000   0.214

В этом случае на самом деле невозможно векторизовать код с помощью strsplit, поэтому нам нужно использовать что-то еще. Антониос показал мне, как это сделать, используя substr :

1
2
3
> system.time(googleTrends %>% mutate(start = substr(week, 1, 10) %>% ymd()))
   user  system elapsed
  0.018   0.000   0.017

Расчет расстояния хаверсин

Я хотел найти большое круговое расстояние от коллекции мест до центра Лондона. Я начал с этого фрейма данных:

01
02
03
04
05
06
07
08
09
10
11
centre = c(-0.129581, 51.516578)
venues = read.csv("/tmp/venues.csv")
  
> venues %>% head()
                       venue   lat      lon
1              Skills Matter 51.52 -0.09911
2                   Skinkers 51.50 -0.08387
3          Theodore Bullfrog 51.51 -0.12375
4 The Skills Matter eXchange 51.52 -0.09923
5               The Guardian 51.53 -0.12234
6            White Bear Yard 51.52 -0.10980

Моя не векторизованная версия выглядела так:

1
2
3
4
5
> system.time(venues %>%
    mutate(distanceFromCentre = by(venues, 1:nrow(venues), function(row) { distHaversine(c(row$lon, row$lat), centre)  }))
    )
   user  system elapsed
  0.034   0.000   0.033

Это довольно быстро, но мы можем добиться большего — функция distHaversine позволяет нам вычислять несколько расстояний, если первый аргумент — это матрица значений lon / lat, а не вектор:

1
2
3
4
5
> system.time(
    venues %>% mutate(distanceFromCentre = distHaversine(cbind(venues$lon, venues$lat), centre))
    )
   user  system elapsed
  0.001   0.000   0.001

Один я не могу понять …

И, наконец, у меня есть функция, которую я не могу понять, как векторизовать, но, может быть, кто-то с большим умением R, чем я, может?

У меня есть фрейм данных, содержащий совокупное количество членов различных групп NoSQL London :

01
02
03
04
05
06
07
08
09
10
11
12
13
cumulativeMeetupMembers = read.csv("/tmp/cumulativeMeetupMembers.csv")
> cumulativeMeetupMembers %>% sample_n(10)
                               g.name dayMonthYear    n
4734            Hadoop Users Group UK   2013-10-26 1144
4668            Hadoop Users Group UK   2013-08-03  979
4936            Hadoop Users Group UK   2014-07-31 1644
5150                      Hive London   2012-10-15  109
8020        Neo4j - London User Group   2014-03-15  826
7666        Neo4j - London User Group   2012-08-06   78
1030                  Big Data London   2013-03-01 1416
6500        London MongoDB User Group   2013-09-21  952
8290 Oracle Big Data 4 the Enterprise   2012-06-04   61
2584              Data Science London   2012-03-20  285

И я хочу узнать количество участников группы на конкретную дату. например, учитывая следующие данные …

01
02
03
04
05
06
07
08
09
10
11
12
> cumulativeMeetupMembers %>% head(10)
                                          g.name dayMonthYear  n
1  Big Data / Data Science / Data Analytics Jobs   2013-01-29  1
2  Big Data / Data Science / Data Analytics Jobs   2013-02-06 15
3  Big Data / Data Science / Data Analytics Jobs   2013-02-07 28
4  Big Data / Data Science / Data Analytics Jobs   2013-02-10 31
5  Big Data / Data Science / Data Analytics Jobs   2013-02-18 33
6  Big Data / Data Science / Data Analytics Jobs   2013-03-27 38
7  Big Data / Data Science / Data Analytics Jobs   2013-04-16 41
8  Big Data / Data Science / Data Analytics Jobs   2013-07-17 53
9  Big Data / Data Science / Data Analytics Jobs   2013-08-28 58
10 Big Data / Data Science / Data Analytics Jobs   2013-11-11 63

… Количество участников группы «Большие данные / Data Science / Data Analytics» на 10 ноября 2013 года должно быть 58.

Я создал этот фрейм данных групп и случайных дат:

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
dates = ymd("2014-09-01") + c(0:9) * weeks(1)
groups = cumulativeMeetupMembers %>% distinct(g.name) %>% select(g.name)
  
groupsOnDate = merge(dates, groups)
names(groupsOnDate) = c('date', 'name')
  
> groupsOnDate %>% sample_n(10)
          date                                            name
156 2014-10-06                                 GridGain London
153 2014-09-15                                 GridGain London
70  2014-11-03                                Couchbase London
185 2014-09-29                           Hadoop Users Group UK
105 2014-09-29                             Data Science London
137 2014-10-13            Equal Experts Technical Meetup Group
360 2014-11-03                        Scale Warriors of London
82  2014-09-08 Data Science & Business Analytics London Meetup
233 2014-09-15                 London ElasticSearch User Group
84  2014-09-22 Data Science & Business Analytics London Meetup

Не векторизованная версия выглядит так:

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
memberCount = function(meetupMembers) {
  function(groupName, date) {
    (meetupMembers %>%
       filter(g.name == groupName & dayMonthYear < date) %>% do(tail(., 1)))$n   
  } 
}
  
findMemberCount = memberCount(cumulativeMeetupMembers)
  
> system.time(groupsOnDate %>% mutate(groupMembers = by(groupsOnDate, 1:nrow(groupsOnDate), function(row) {
          findMemberCount(row$name, as.character(row$date))
        }) %>%
        cbind() %>%
        as.vector() ))
   user  system elapsed
  2.259   0.005   2.269

Вывод выглядит так:

01
02
03
04
05
06
07
08
09
10
11
date                                   name             groupMembers
116 2014-10-06                      DeNormalised London          157
322 2014-09-08                 OpenCredo Tech Workshops            7
71  2014-09-01                  Data Enthusiasts London            
233 2014-09-15          London ElasticSearch User Group          614
171 2014-09-01 HPC & GPU Supercomputing Group of London           80
109 2014-10-27                      Data Science London         3632
20  2014-11-03            Big Data Developers in London          708
42  2014-09-08              Big Data Week London Meetup           96
127 2014-10-13          Enterprise Search London Meetup          575
409 2014-10-27                            Women in Data          548

Я испробовал много разных подходов, но не смог придумать версию, позволяющую мне передавать все строки в memberCount и вычислять количество для каждой строки за один раз.

Любые идеи / советы / советы приветствуются!

Ссылка: Р: Векторизация всех вещей от нашего партнера JCG Марка Нидхэма в блоге Марка Нидхэма .
40
Share: