2014-10-10 104 views
2

我有R的腳本,需要8分鐘的運行,基本上比較了多年期間800個記錄的日期範圍。這太長了。我是R新手,很確定它與我的嵌入式循環有關。另外,當我試圖將我的數據轉換爲玩具問題時,它似乎不起作用。我一直在處理從excel中讀取的數組類型。提高R的效率(矢量化?)

# data vectors 
ID <- c("1e", "1f", "1g") 
StartDate <- c(1, 2, 4) 
EndDate <- c(3, 4, 5) 
Type <- c("A", "B", "B") 
Qty <- c(.5, 2.5, 1) 

# table rows and headers 
Days <- c(1, 2, 3, 4, 5) 
setOfTypes <- c("A", "B") 

# get subset of active IDs for each day in table 
ActiveID <- data.frame() 
for(d in 1:length(Days)){ 
    check <- StartDate<=Days[d] & EndDate>=Days[d] 
    subsetID <- subset(ID, check) 
    strSubsetID <- c() 
    for(i in 1:length(subsetID)){ 
    strSubsetID <- paste(ID, subsetID[i], sep=",") 
} 
ActiveID[d,1] <- strSubsetID 
} 

# calculate quantity counts by day and type 
Count <- matrix(,length(Days),length(setOfTypes)) 
for(d in 1:length(Days)){ 
    for(t in 1:length(setOfTypes)) 
    check <- Type == setOfTypes[t] & sapply(ID, grepl, x=ActiveID[d,1]) 
    tempCount <- subset(Types, check) 
    Count[t,d] <- sum(tempCount) 
    } 
} 

結果應該是一個表(天×類型)具有由數量的用於在給定的一天和型有源ID的總和的每個元素。

我正在尋找矢量化這段代碼,所以它適用於更大的數據集時運行得更快!請幫忙,謝謝。

+0

你看過reshape2或plyr包嗎? – dayne 2014-10-10 16:30:11

+1

請顯示您的預期結果 – 2014-10-10 16:30:48

回答

4

你的代碼不能按原樣運行,所以我無法準確知道你在找什麼。您的描述建議您需要Days之間StartDateEndDate之間的Qty的總和,按Type分組。這將產生這樣一個矩陣:

df <- data.frame(ID,StartDate,EndDate,Type,Qty,stringsAsFactors=FALSE) 
Days <- min(StartDate):max(EndDate) 

is.between <- function(x,df) with(df,x>=StartDate & x<=EndDate) 
get.sums <- function(df) sapply(Days,function(d,df) sum(df[is.between(d,df),"Qty"]),df) 
do.call(rbind,lapply(split(df,df$Type), get.sums)) 
# [,1] [,2] [,3] [,4] [,5] 
# A 0.5 0.5 0.5 0.0 0 
# B 0.0 2.5 2.5 3.5 1 

這是一個data.table方法,可能會更快。請注意0​​和get.sums(...)的不同定義。

DT <- data.table(df,key="Type") 
is.between <- function(x,a,b) x>=a & x <= b 
get.sums <- function(day) DT[,list(day,Qty=sum(Qty[is.between(day,StartDate,EndDate)])),by=Type] 
long  <- rbindlist(lapply(Days,get.sums)) 
result  <- dcast.data.table(long,Type~day,value.var="Qty") 
result 
# Type 1 2 3 4 5 
# 1: A 0.5 0.5 0.5 0.0 0 
# 2: B 0.0 2.5 2.5 3.5 1 

這裏有一些基準測試與希望比較有代表性的例子的數據集(800行,500個開始日期,總日期範圍>900天),也測試@阿倫的回答。

# more representative example 
set.seed(1) # for reproducibility 
StartDate <- sample(1:500,800,replace=TRUE) 
EndDate <- StartDate + rpois(800,400) 
Type  <- sample(LETTERS[1:20],800,replace=TRUE) 
Qty  <- rnorm(800,10,2) 
Days  <- min(StartDate):max(EndDate) 
df  <- data.frame(StartDate,EndDate,Type,Qty, stringsAsFactors=FALSE) 

比較數據幀方法和兩種數據表方法。

library(data.table) 
library(reshape2) 
DT <- data.table(df,key="Type") 
f.df <- function() { 
    is.between <- function(x,df) with(df,x>=StartDate & x<=EndDate) 
    get.sums <- function(df) sapply(Days,function(d,df) sum(df[is.between(d,df),"Qty"]),df) 
    do.call(rbind,lapply(split(df,df$Type), get.sums)) 
} 
f.dt1 <- function() { 
    is.between <- function(x,a,b) x>=a & x <= b 
    get.sums <- function(day) DT[,list(day,Qty=sum(Qty[is.between(day,StartDate,EndDate)])),by=Type] 
    long  <- rbindlist(lapply(Days,get.sums)) 
    dcast.data.table(long,Type~day,value.var="Qty") 
} 
f.dt2 <- function() { 
    lookup <- data.table(StartDate=Days, EndDate=Days) 
    setkey(lookup) 
    j_olaps <- foverlaps(DT, lookup, by.x=c("StartDate", "EndDate"), type="any") 
    dcast.data.table(j_olaps, Type ~ StartDate, value.var="Qty", fun.agg=sum, na.rm=TRUE) 
} 
identical(f.dt1(),f.dt2()) # same result? YES! 
# [1] TRUE 
library(microbenchmark) 
microbenchmark(f.df(),f.dt1(),f.dt2(),times=10) 
# Unit: milliseconds 
#  expr  min   lq median  uq  max neval 
# f.df() 1199.76370 1212.03787 1222.6558 1243.8743 1275.5526 10 
# f.dt1() 1634.92675 1664.98885 1689.7812 1714.2662 1798.9121 10 
# f.dt2() 91.53245 95.19545 129.2789 158.0789 208.1818 10 

So @ Arun的方法比df方法快10倍,比上面dt方法快17倍。

+0

這真棒!非常感謝。我看到從8分鐘降低到25秒。這是最高效的嗎?我將不得不在更大的數據集上應用這一點,所以我很樂意看到在800條記錄和1000條時間記錄中這會降低到5-10秒。 – 2014-10-10 17:50:40

+0

查看我的編輯。最快的方法是用C代碼。 – jlhoward 2014-10-10 18:40:45

+0

非常感謝。我會試試看,我相信它效果更好。我選擇R的原因是我在Alteryx軟件中使用它。如果你還沒有檢查過Alteryx的大數據和高級分析,我強烈推薦它。 – 2014-10-10 20:04:47

2

查看@ jihoward的代碼,這似乎是重疊連接的一種情況,它最近在0123.的v1.9.4中實現。該功能被稱爲foverlaps()。以下是我們如何使用它的方法:

首先,我們創建一個查找表,其中包含我們希望重疊連接的日期範圍。這是使用@ jihoward代碼中的變量Days構建的。你的情況開始和結束日期是相同的。

require(data.table) ## 1.9.4 
lookup <- data.table(StartDate=Days, EndDate=Days) 
setkey(lookup) 

然後我們使用foverlaps()來計算重疊連接。這裏的重疊類型被指定爲any。看看?foverlaps來找出這意味着什麼,以及其他類型的重疊可以做。

j_olaps = foverlaps(DT, lookup, by.x=c("StartDate", "EndDate"), type="any") 

現在,我們的重疊,我們可以簡單地將它轉換爲:

dcast.data.table(j_olaps, Type ~ StartDate, value.var="Qty", fun.agg=sum, na.rm=TRUE) 

# Type 1 2 3 4 5 
# 1: A 0.5 0.5 0.5 0.0 0 
# 2: B 0.0 2.5 2.5 3.5 1 

我相信這應該是速度遠遠超過不必做一個矢量掃描基於子集中的每個元素在Days。如果有的話,知道你獲得了多少加速會很棒!

HTH

+1

按照上面的一些基準 - 你的是最快的方法。 – jlhoward 2014-10-11 02:42:07

+0

@jlhoward,太棒了!謝謝。 – Arun 2014-10-11 08:15:42

+0

再次感謝。非常感激。 – 2014-10-15 13:25:22