優化 R 中的 ifelse + 循環
[英]Optimizing ifelse + loop in R
問題描述
[[[[我一直在嘗試優化R中的一個循環，但因為我不是專家，我無法取得太大進展。 我想知道您是否可以幫助我，因為這花費了太多時間。]]]]
基本上，我有一個數據框和一個數據框列表，如下所示：
set.seed(123)
spp.list <- c("spA", "spB")
locations <- c("loc1", "loc2")
depths <- c(0:1)
years <- c(2000, 2001)
months <- c(1,2)
#Dataframe 1 (f.data):
n.rows <- 10
f.data <- data.frame(spp = sample(spp.list, n.rows, replace = T),
location = sample(locations, n.rows, replace = T),
depth = sample(depths, n.rows, replace = T),
Y = sample(years, n.rows, replace = T),
M = sample(months, n.rows, replace = T)
)
#List of dataframes (loc.list)
loc1 <- data.frame(Y = years,
M = months,
'0' = c(10,15),
'1' = c(0,5)
)
names(loc1)[3:4] <- c(-0,-1)
loc2 <- data.frame(Y = years,
M = months,
'0' = c(13,18),
'1' = c(3,7)
)
names(loc2)[3:4] <- c(-0,-1)
loc.list <- list(loc1,loc2)
names(loc.list) <- c('loc1','loc2')
Dataframe 1 (f.data) 包含物種、地點、深度、年份和月份的列表。 數據幀列表 (loc.list) 包含每個位置的單獨數據幀（在 f.data 中幾乎相同的位置）。 此列表中的每個單獨的 dataframe 還將包含年和月，還包含元素的不同類別的值（深度；在這種情況下，每個深度由獨立的列表示：0 = 表面，-1 = 1 m 深）。
我需要做的是篩選這兩個元素以匹配位置、深度、年份和月份，以便我可以將 loc.list 中記錄的值分配給 f.data。 例如，f.data 的第一行表示“loc2”、深度“0”、2000 年和第 1 個月。查看 loc.list、loc2 的值、2000 年、第 1 個月和深度 0（第 0 列）是 13。因此，我將把這個值 (13) 復制到 f.data (f.data$temp) 的新列中。
> f.data
spp location depth Y M
1 spA loc2 0 2000 1 <<<----
2 spA loc2 1 2001 2
3 spA loc2 0 2000 2
4 spB loc1 0 2001 1
5 spA loc2 0 2001 1
6 spB loc1 0 2000 1
7 spB loc2 1 2000 1
8 spB loc1 1 2000 2
9 spA loc1 0 2000 1
10 spA loc1 1 2001 1
> loc.list
$loc1
Y M 0 -1
1 2000 1 10 0
2 2001 2 15 5
$loc2
Y M 0 -1
1 2000 1 13 3 <<<----
2 2001 2 18 7
最初，我編寫了一個基本的長代碼來完成這項工作，但這需要時間。 例如，對於 n.rows = 100000，我的機器需要大約 18 秒。
f.data$temp <- NA
start.time <- Sys.time()
for (i in (1:nrow(f.data))) {
tryCatch({
for (j in 1:length(loc.list)) {
for (k in 1:nrow(loc.list[[j]])) {
for (m in 3:ncol(loc.list[[j]])) {
if (f.data$location[i] == names(loc.list)[j]) {
if (f.data$Y[i] == loc.list[[j]]$Y[k]){
if (f.data$M[i] == loc.list[[j]]$M[k]) {
if (round(f.data$depth[i], digits = 0) == (as.numeric (names(loc.list[[j]])[m])*(-1))) {
f.data$temp[i] <- loc.list[[j]][k,m]
}
}
}
}
}
}
}
}, error = function(e){})
}
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
> f.data
spp location depth Y M temp
1 spA loc2 0 2000 1 13
2 spA loc2 1 2001 2 7
3 spA loc2 0 2000 2 NA
4 spB loc1 0 2001 1 NA
5 spA loc2 0 2001 1 NA
6 spB loc1 0 2000 1 10
7 spB loc2 1 2000 1 3
8 spB loc1 1 2000 2 NA
9 spA loc1 0 2000 1 10
10 spA loc1 1 2001 1 NA
我使用 ifelse() 對代碼進行了一些改進，但在經典循環中。 使用 n.rows = 100000，我可以在不到一秒的時間內完成。
f.data2 <- f.data[,-length(f.data)]
res2 <- c()
start.time2 <- Sys.time()
for (i in 1:length(loc.list)) { # to assess each df in the list
for (j in 1:nrow(loc.list[[i]])) { # to assess each row of each df in the list
for (m in 3:ncol(loc.list[[i]])) { # to assess each colum of each df in the list
res <- ifelse(f.data2$location == names(loc.list)[i] &
f.data2$Y == loc.list[[i]]$Y[j] &
f.data2$M == loc.list[[i]]$M[j] &
round(f.data2$depth, digits = 0) == (as.numeric (names(loc.list[[i]])[m])*(-1)),
loc.list[[i]][j,m], NA
)
res2 <- cbind(res2,res)
}
}
}
end.time2 <- Sys.time()
time.taken2 <- end.time2 - start.time2
time.taken2
f.data2 <- cbind(f.data2,res2)
f.data2$res.final <- rowMeans(f.data2[,(ncol(f.data2)-ncol(res2)+1):(ncol(f.data2))],
na.rm=T)
f.data2 <- f.data2[, -c((ncol(f.data2)-ncol(res2)):(ncol(f.data2)-1)) ]
f.data2
f.data
sum(!(f.data$temp == f.data2$res.final), na.rm=T)
但是因為實際上我有一個具有 88062 行的 f.data 和一個具有 58 個 dfs 的 loc.list，它們的大小變化很大（分別為 81-479 x 9-375 行和列），我的“優化”代碼仍然是永遠服用。 如果有人能提供有關如何使這更快的見解，我將不勝感激。 發送。 大號
2 個解決方案
解決方案1
2 2022-09-19 17:26:31
這聽起來像是一個連接，它可以在沒有循環的情況下很快完成。 在這里，我將數據框列表組合成一個數據框，其中的location列包含每個原始表的名稱。 然后我們加入（這里使用dplyr::left_join但可以使用 base merge ，或data.table或duckdb ，如果需要，可以collapse以獲得更快的速度）。
library(tidyverse)
loc.list.df <- do.call(rbind.data.frame, loc.list) %>%
rownames_to_column() %>%
separate(rowname, c("location", "row"))
f.data %>%
left_join(loc.list.df)
結果
Joining, by = c("location", "Y", "M")
spp location depth Y M row 0 -1
1 spA loc2 0 2000 1 1 13 3
2 spA loc2 1 2001 2 2 18 7
3 spA loc2 0 2000 2 <NA> NA NA
4 spB loc1 0 2001 1 <NA> NA NA
5 spA loc2 0 2001 1 <NA> NA NA
6 spB loc1 0 2000 1 1 10 0
7 spB loc2 1 2000 1 1 13 3
8 spB loc1 1 2000 2 <NA> NA NA
9 spA loc1 0 2000 1 1 10 0
10 spA loc1 1 2001 1 <NA> NA NA
解決方案2
0 2022-09-19 18:03:21
感謝@Limey 和@Jon 的評論。 它有很大幫助。 首先，我遵循 Limey 的建議，將數據框列表綁定在一個列表中。 （可能有更優雅的代碼可用）：
loc.list.merged <- list()
for (j in 1:length(loc.list)) {
loc.list1 <- loc.list[[j]]
x.loc.list <- list()
for (i in 3:ncol(loc.list1)) {
x <- data.frame(loc.list1[,i])
names(x) <- 'temp'
x$depth <- names(loc.list1)[i]
x$Y <- loc.list1$Y
x$M <- loc.list1$M
x$locality <- names(loc.list[j])
x.loc.list[[i-2]] <- x
}
library(dplyr)
yy <- Reduce(full_join,x.loc.list)
loc.list.merged[[j]] <- yy
}
loc.list.merged2 <- Reduce(full_join, loc.list.merged)
loc.list.merged2$depth <- as.numeric(loc.list.merged2$depth)*(-1)
names(loc.list.merged2)[5] <- 'location'
> loc.list.merged2
temp depth Y M location
1 10 0 2000 1 loc1
2 15 0 2001 2 loc1
3 0 1 2000 1 loc1
4 5 1 2001 2 loc1
5 13 0 2000 1 loc2
6 18 0 2001 2 loc2
7 3 1 2000 1 loc2
8 7 1 2001 2 loc2
然后我應用了喬恩的建議：
library(dplyr)
f.data4 <-
f.data3 %>% left_join(loc.list.merged2)
> f.data4
spp location depth Y M temp
1 spA loc2 0 2000 1 13
2 spA loc2 1 2001 2 7
3 spA loc2 0 2000 2 NA
4 spB loc1 0 2001 1 NA
5 spA loc2 0 2001 1 NA
6 spB loc1 0 2000 1 10
7 spB loc2 1 2000 1 3
8 spB loc1 1 2000 2 NA
9 spA loc1 0 2000 1 10
10 spA loc1 1 2001 1 NA
它似乎工作。 明天我會在我的實際數據集上嘗試。
R循環中的ifelse
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.