r - 损坏的代码 - 如何使用以前有效的 group

问题描述

我最近问了一个问题“我可以使用 group_map 或 group_walk 来迭代导出结果吗？” ，并且代码运行良好，但截至今天，它不再有效。我尝试更新我的包和 RStudio，但这没有用。数据是：

迷你型	迷你检测	标准分析	频率
化验1	否定	否定	19
化验1	否定	位置	5
化验1	位置	否定	8
化验1	位置	位置	141
化验2	否定	否定	25
化验2	否定	位置	6
化验2	位置	否定	17
化验2	位置	位置	33
化验3	否定	否定	99
化验3	否定	位置	20
化验3	位置	否定	5
化验3	位置	位置	105

代码是：

check_create_dir <- function(the_dir) {
  if (!dir.exists(the_dir)) {
    dir.create(the_dir, recursive = TRUE) } #Creates a directory if it doesn't already exist
}
the_dir_ex <- "data_generated/epidata" #Name the new desired directory


check_create_dir(the_dir_ex) #Make the directory if it doesn't already exist

#Make function for the series of analyses
epi_analysis <- function(a_csv, the_dir){
  #Clean data
  dat2 <- a_csv  %>%
    select(c(MiniAssay, StandardAssay, Freq)) %>%
    pivot_wider(MiniAssay, names_from = StandardAssay, values_from = Freq) %>%
    remove_rownames %>% 
    column_to_rownames(var = "MiniAssay") %>% 
    as.matrix() 
  
  #Run tests
  rval <- epi.tests(dat2, conf.level = 0.95)
  rkappa <- epi.kappa(dat2)
  gwet <- gwet.ac1.table(dat2)
  gwet_ci <- gwet$coeff.ci #CI is presented as (###,###); needs to be cleaned to separate lwr and upr vals
  gwet_ci <- gsub('[\\(]', '', gwet_ci)#Removes ( from string
  gwet_ci <- gsub('[\\)]', '', gwet_ci)#Removes ) from string
  gwet_ci <- strsplit(gwet_ci, ",")#Splits string at , so that it becomes a list of 1 with 2 different characters
  kappa2 <- kappa2.table(dat2)
  kappa_ci <- kappa2$coeff.ci #CI is presented as (###,###); needs to be cleaned to separate lwr and upr vals
  kappa_ci <- gsub('[\\(]', '', kappa_ci)#Removes ( from string
  kappa_ci <- gsub('[\\)]', '', kappa_ci)#Removes ) from string
  kappa_ci <- strsplit(kappa_ci, ",")#Splits string at , so that it becomes a list of 1 with 2 different characters 
  
  #Export results
  hd <- c('sensitivity', 'specificity','ppv','npv', 'pfp', 'pfn', 'kappa', 'gwet', 'pabak')
  
  ests <- c(round(rval$elements$sensitivity$est, digits = 3), 
            round(rval$elements$specificity$est, digits = 3),
            round(rval$elements$ppv, digits = 3), 
            round(rval$elements$npv, digits = 3), 
            round(rval$element$pfp$est, digits = 3), 
            round(rval$element$pfn$est, digits = 3), 
            round(kappa2$coeff.val, digits = 3), 
            round(gwet$coeff.val, digits = 3), 
            round(rkappa$pabak$est, digits = 3))
  
  ci_lwr <- c(round(rval$elements$sensitivity$lower, digits = 3), 
              round(rval$elements$specificity$lower, digits = 3),
              round(rval$elements$ppv.low , digits = 3), 
              round(rval$elements$npv.low, digits = 3), 
              round(rval$element$pfp$lower, digits = 3),  
              round(rval$element$pfn$lower, digits = 3), 
              kappa_ci[[1]][1], 
              gwet_ci[[1]][1],
              round(rkappa$pabak$lower, digits = 3))
  
  ci_upr <- c(round(rval$elements$sensitivity$upper, digits = 3), 
              round(rval$elements$specificity$upper, digits = 3),
              round(rval$elements$ppv.up , digits = 3), 
              round(rval$elements$npv.up, digits = 3), 
              round(rval$element$pfp$upper, digits = 3),  
              round(rval$element$pfn$upper, digits = 3), 
              kappa_ci[[1]][2], 
              gwet_ci[[1]][2], 
              round(rkappa$pabak$upper, digits = 3))
  
  write.csv(df, 
            file = sprintf('%s/%s.csv', the_dir, a_csv$MiniType[1]),
            na = "999.99", 
            row.names = FALSE)
  
}

当我尝试执行这些功能时：

#Execute functions
data <- read_csv("data_raw/EpiData.csv") %>%
  group_by(MiniType)%>%
  group_map(~ epi_analysis(., the_dir_ex), .keep = TRUE)

我得到：

 Error in as.data.frame.default(x[[i]], optional = TRUE) : 
  cannot coerce class ‘&quot;function"’ to a data.frame 
16.
stop(gettextf("cannot coerce class %s to a data.frame", sQuote(deparse(class(x))[1L])), 
    domain = NA) 
15.
as.data.frame.default(x[[i]], optional = TRUE) 
14.
as.data.frame(x[[i]], optional = TRUE) 
13.
data.frame(x) 
12.
write.table(df, file = sprintf("%s/%s.csv", the_dir, a_csv$MiniType[1]), 
    na = "999.99", row.names = FALSE, col.names = TRUE, sep = ",", 
    dec = ".", qmethod = "double") 
11.
eval(expr, p) 
10.
eval(expr, p) 
9.
eval.parent(Call) 
8.
write.csv(df, file = sprintf("%s/%s.csv", the_dir, a_csv$MiniType[1]), 
    na = "999.99", row.names = FALSE) 
7.
epi_analysis(., the_dir_ex) 
6.
(structure(function (..., .x = ..1, .y = ..2, . = ..1) 
epi_analysis(., the_dir_ex), class = c("rlang_lambda_function", 
"function")))(dots[[1L]][[1L]], dots[[2L]][[1L]]) 
5.
mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE) 
4.
map2(chunks, group_keys, .f, ...) 
3.
group_map.data.frame(., ~epi_analysis(., the_dir_ex), .keep = TRUE) 
2.
group_map(., ~epi_analysis(., the_dir_ex), .keep = TRUE) 
1.
read_csv("data_raw/EpiData.csv") %>% group_by(MiniType) %>% group_map(~epi_analysis(., 
    the_dir_ex), .keep = TRUE)

如果我尝试执行以下功能：

#ALTERNATE EXECUTE FUNCTION (AS AN EXAMPLE)
read_csv("data_raw/EpiData.csv") %>%
  group_split(MiniType) %>%
  map(~ epi_analysis(.x, the_dir_ex))

这在以前也很好用，但现在我得到了：

Error in as.data.frame.default(x[[i]], optional = TRUE) : 
  cannot coerce class ‘&quot;function"’ to a data.frame 
13.
stop(gettextf("cannot coerce class %s to a data.frame", sQuote(deparse(class(x))[1L])), 
    domain = NA) 
12.
as.data.frame.default(x[[i]], optional = TRUE) 
11.
as.data.frame(x[[i]], optional = TRUE) 
10.
data.frame(x) 
9.
write.table(df, file = sprintf("%s/%s.csv", the_dir, a_csv$MiniType[1]), 
    na = "999.99", row.names = FALSE, col.names = TRUE, sep = ",", 
    dec = ".", qmethod = "double") 
8.
eval(expr, p) 
7.
eval(expr, p) 
6.
eval.parent(Call) 
5.
write.csv(df, file = sprintf("%s/%s.csv", the_dir, a_csv$MiniType[1]), 
    na = "999.99", row.names = FALSE) 
4.
epi_analysis(.x, the_dir_ex) 
3.
.f(.x[[i]], ...) 
2.
map(., ~epi_analysis(.x, the_dir_ex)) 
1.
read_csv("data_raw/EpiData.csv") %>% group_split(MiniType) %>% 
    map(~epi_analysis(.x, the_dir_ex))

我正在操作一台装有 Windows 10、R v4.0.3 和 RStudio v1.4.1717 的 PC

我需要让这段代码再次工作，感谢任何帮助。

标签： rtidyversepurrr

r - 损坏的代码 - 如何使用以前有效的 group_map 修复函数？

问题描述

解决方案

推荐阅读