我正在嘗試將 for 回圈轉換為任何應用系列以進行代碼優化
這是示例資料
my_data = structure(list(Sector = c("AAA", "BBB", "AAA", "CCC", "AAA",
"BBB", "AAA", "CCC"), Sub_Sector = c("AAA1", "BBB1", "AAA1",
"CCC1", "AAA1", "BBB2", "AAA1", "CCC2"), count = c(1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L), type = c("Actual", "Actual", "Actual", "Actual",
"Actual", "Actual", "Actual", "Actual")), class = "data.frame", row.names = c(NA,
-8L))
實際功能（使用 for 回圈）此功能為我們提供了預期的輸出
expand_collapse_compliance <- function(right_table){
sector_list <- unique(right_table$Sector)
df = data.frame("Sector1"=c(""),"Sector"=c(""),"Sub_Sector"=c(""),"Actual"=c(""))
for(s in sector_list){
df1 = right_table[right_table$Sector==s,]
sector1 = df1$Sector[1]
Sector = df1$Sector[1]
Sub_Sector = ""
actual = as.character(nrow(df1))
mainrow = c(sector1,Sector,Sub_Sector,actual)
df = rbind(df,mainrow)
Sub_Sector_list <- unique(df1$Sub_Sector)
for(i in Sub_Sector_list){
df2 = right_table[right_table$Sub_Sector==i,]
sector1 = df1$Sector[1]
Sector = ""
Sub_Sector = df2$Sub_Sector[1]
actual = nrow(df2)
subrow = c(sector1,Sector,Sub_Sector,actual)
df = rbind(df,subrow)
}
}
df = df[2:nrow(df),]
df$Actual = as.numeric(df$Actual)
df_total = nrow(right_table)
df = rbind(df,c("","Total","",df_total))
return(df)
}
DT::datatable(expand_collapse_compliance(mydata1),
rownames = F,escape = FALSE,
selection=list(mode="single",target="row"),
options = list(pageLength = 50,scrollX = TRUE,
dom = 'tp',ordering=F,
columnDefs = list(list(visible=FALSE, targets=0),
list(className = 'dt-left', targets = '_all'))),class='hover cell-border stripe')
我嘗試先將內回圈轉換為 lapply，同時這樣做 sub_sector 值未顯示在輸出表中，請讓我知道如何解決任何想法將不勝感激
expand_collapse_compliance <- function(right_table){
sector_list <- unique(right_table$Sector)
df = data.frame("Sector1"=c(""),"Sector"=c(""),"Sub_Sector"=c(""),"Actual"=c(""))
for(s in sector_list){
df1 = right_table[right_table$Sector==s,]
sector1 = df1$Sector[1]
Sector = df1$Sector[1]
Sub_Sector = ""
actual = as.character(nrow(df1))
mainrow = c(sector1,Sector,Sub_Sector,actual)
df = rbind(df,mainrow)
Sub_Sector_list <- unique(df1$Sub_Sector)
#for(i in Sub_Sector_list){
lapply(Sub_Sector_list, function(x){
df2 = right_table[right_table$Sub_Sector==Sub_Sector_list,]
sector1 = df1$Sector[1]
Sector = ""
Sub_Sector = df2$Sub_Sector[1]
actual = nrow(df2)
subrow = c(sector1,Sector,Sub_Sector,actual)
df = rbind(df,subrow)
})
}
df = df[2:nrow(df),]
df$Actual = as.numeric(df$Actual)
df_total = nrow(right_table)
df = rbind(df,c("","Total","",df_total))
return(df)
}
uj5u.com熱心網友回復：
使用dplyr和tidyr你可以這樣做：
注意：我放下了DT零件。
library(dplyr)
library(tidyr)
expand_collapse_compliance1 <- function(x) {
x <- x %>%
count(Sector, Sub_Sector, name = "Actual") %>%
group_split(Sector) %>%
lapply(function(x) {
main <- group_by(x, Sector) %>% summarise(Actual = sum(Actual))
bind_rows(main, x)
}) %>%
bind_rows() %>%
mutate(Sector1 = Sector) %>%
select(Sector1, Sector, Sub_Sector, Actual)
total <- x %>%
filter(is.na(Sub_Sector)) %>%
group_by(Sector = "Total") %>%
summarise(Actual = sum(Actual))
bind_rows(x, total) %>%
mutate(Sector = ifelse(!is.na(Sub_Sector), "", Sector)) %>%
replace_na(list(Sub_Sector = "", Sector1 = ""))
}
expand_collapse_compliance1(my_data)
#> # A tibble: 9 × 4
#> Sector1 Sector Sub_Sector Actual
#> <chr> <chr> <chr> <int>
#> 1 "AAA" "AAA" "" 4
#> 2 "AAA" "" "AAA1" 4
#> 3 "BBB" "BBB" "" 2
#> 4 "BBB" "" "BBB1" 1
#> 5 "BBB" "" "BBB2" 1
#> 6 "CCC" "CCC" "" 2
#> 7 "CCC" "" "CCC1" 1
#> 8 "CCC" "" "CCC2" 1
#> 9 "" "Total" "" 8
expand_collapse_compliance(my_data)
#> Sector1 Sector Sub_Sector Actual
#> 2 AAA AAA 4
#> 3 AAA AAA1 4
#> 4 BBB BBB 2
#> 5 BBB BBB1 1
#> 6 BBB BBB2 1
#> 7 CCC CCC 2
#> 8 CCC CCC1 1
#> 9 CCC CCC2 1
#> 91 Total 8
uj5u.com熱心網友回復：
不需要任何回圈或應用，我們想要的是三個不同的組計數和一些格式。根據假設 - 正如示例資料中所見 - 不需要拆分。
my_data = structure(list(Sector = c("AAA", "BBB", "AAA", "CCC", "AAA",
"BBB", "AAA", "CCC"), Sub_Sector = c("AAA1", "BBB1", "AAA1",
"CCC1", "AAA1", "BBB2", "AAA1", "CCC2"), count = c(1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L), type = c("Actual", "Actual", "Actual", "Actual",
"Actual", "Actual", "Actual", "Actual")), class = "data.frame", row.names = c(NA,
-8L))
library(data.table)
setDT(my_data)
expand_collapse_compliance <- function(x) {
x <- rbindlist(list(
x[, .(Sector1 = Sector, Actual = .N), by = Sector],
setnames(x[, .(Actual = .N), by = .(Sector, Sub_Sector)], "Sector", "Sector1"),
x[, .(Sector = "Total", Actual = .N)]
), fill = T)
setcolorder(x, c("Sector1", "Sector", "Sub_Sector", "Actual"))
setorder(x, Sector1, Sector, na.last = T)
x
}
expand_collapse_compliance(my_data)
# Sector1 Sector Sub_Sector Actual
# 1: AAA AAA <NA> 4
# 2: AAA <NA> AAA1 4
# 3: BBB BBB <NA> 2
# 4: BBB <NA> BBB1 1
# 5: BBB <NA> BBB2 1
# 6: CCC CCC <NA> 2
# 7: CCC <NA> CCC1 1
# 8: CCC <NA> CCC2 1
# 9: <NA> Total <NA> 8
旁注
沒有必要轉換NA為，""因為閃亮的 DT 會為它顯示 blancs。
速度測驗
正如我所提到的，for在非常小的資料集上通常會更快，因為任何庫解決方案都使用一些需要一些時間才能加載一次的函式......
my_data_small = structure(list(Sector = c("AAA", "BBB", "AAA", "CCC", "AAA",
"BBB", "AAA", "CCC"), Sub_Sector = c("AAA1", "BBB1", "AAA1",
"CCC1", "AAA1", "BBB2", "AAA1", "CCC2"), count = c(1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L), type = c("Actual", "Actual", "Actual", "Actual",
"Actual", "Actual", "Actual", "Actual")), class = "data.frame", row.names = c(NA,
-8L))
library(data.table)
setDT(my_data)
test replications elapsed relative
2 eccB 150 0.32 1.00
1 eccDT 150 0.72 2.25
# well just make it a milion times bigger :D
my_data_large <- rbindlist(rep(list(my_data_small), 1000000L))
test replications elapsed relative
2 eccB 50 79.30 5.146
1 eccDT 50 15.41 1.000
uj5u.com熱心網友回復：
*apply家庭的適當功能可以tapply使用拆分-應用-組合方法。因為我們tapply只在有多個Sub_Sector's時才需要，所以為了速度，我們實作了一個 case 處理。
expand_collapse_complianceA <- \(data) {
r <- do.call(rbind, c(by(data, data$Sector, \(x) {
if (length(unique(x$Sub_Sector)) != 1L) {
tt <- t(unname(with(x, tapply(count, list(Sector, Sub_Sector), sum))))
tt <- cbind(x[!duplicated(x$Sub_Sector), 1:2], foo='', Actual=tt)
} else {
tt <- as.data.frame(t(c(unlist(x[!duplicated(x$Sub_Sector), 1:2]), foo='',
Actual=sum(x$count))))
}
rbind(c(tt[1, 1], '', tt[1, 1], sum(as.numeric(tt[, 4]))), tt)[c(1, 3, 2, 4)]
}), make.row.names=FALSE))
rbind(r, c('', 'Total', '', sum(as.numeric(r$Actual[!r$foo %in% ''])))) |>
setNames(c('Sector1', 'Sector', 'Sub_Sector', 'Actual'))
}
注： R version 4.1.2 (2021-11-01)。
給
expand_collapse_compliance(my_data)
# Sector1 Sector Sub_Sector Actual
# 1 AAA AAA 4
# 2 AAA AAA1 4
# 3 BBB BBB 2
# 4 BBB BBB1 1
# 5 BBB BBB2 1
# 6 CCC CCC 2
# 7 CCC CCC1 1
# 8 CCC CCC2 1
# 9 Total 8
expand_collapse_complianceA(my_data) |>
(\(x) DT::datatable(
x, rownames=F, escape=FALSE, selection=list(mode="single", target="row"),
options=list(pageLength=50, scrollX=TRUE, dom='tp', ordering=F,
columnDefs=list(list(visible=FALSE, targets=0),
list(className='dt-left', targets='_all'))),
class='hover cell-border stripe'))()
expand_collapse_complianceA現在只需要原始for回圈時間的 1/10 。這是一個基準測驗（在 1080 行上測驗）。
# Unit: milliseconds
# expr min lq mean median uq max neval cld
# ecc_for 304.723781 305.426934 346.878188 308.208294 335.944407 598.94351 10 c
# ecc_tapply 29.768177 29.851975 31.083977 30.611982 32.058980 34.50901 10 a
# ecc_tidy 135.326594 135.952068 143.967550 138.475437 149.352409 164.94652 10 b
# ecc_DT 3.267969 3.611711 4.610916 3.664493 3.707528 13.48797 10 a
當然 data.table 更快。但是，我希望在資料即將耗盡 RAM時看到性能。
基準代碼：
microbenchmark::microbenchmark(
ecc_for=expand_collapse_compliance(dat),
ecc_tapply=expand_collapse_complianceA(dat),
ecc_tidy={library(dplyr);library(tidyr);expand_collapse_compliance1(dat)},
ecc_DT={library(data.table);expand_collapse_complianceDT(as.data.table(dat))},
times=10L)
請注意，到目前為止，“整潔”版本存在一些缺陷（至少對于新資料而言）。
res_for <- expand_collapse_compliance(dat)
res_tapply <- expand_collapse_complianceA(dat)
res_tidy <- {library(dplyr);library(tidyr);expand_collapse_compliance1(dat)}
all.equal(res_for, res_tapply, check.attributes=FALSE)
# [1] TRUE
all.equal(res_for, res_tidy, check.attributes=FALSE)
# [1] "Component “Sub_Sector”: 1053 string mismatches"
# [2] "Component “Actual”: target is character, current is numeric"
資料
dat <- expand.grid(Sector=c("AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ",
"AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU",
"AV", "AW", "AX", "AY", "AZ", "BA"),
Sub_Sector=1:40, stringsAsFactors=F)
dat <- transform(dat, Sub_Sector=Reduce(paste0, dat[1:2]), count=1, type='Actual')
dat <- dat[order(dat$Sector), ]
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/392775.html