如果可能的话,寻找一种更有效的方法来实现此R代码

k0pti3hp  于 12个月前  发布在  其他
关注(0)|答案(3)|浏览(108)

我有下面的R代码,它的工作,但它是相当慢。我想创建一个新的列的基础上的一个现有的列在R框架的值。但有一个catch/并发症,我需要访问和更改一个全局环境变量,该变量保存了多个观测值的比较值。我使用APPLY和一个函数在框架的行上完成了这一点。该函数可以写入和读取外部变量。变量。这是工作,但很慢。有什么方法可以加快这个过程?
第一个观察值中的药物值是起始BASE_VALUE。(药物值),它们不同于BASE_VALUE并且不是BASE_VALUE的子字符串。然后,此观察的药物值将成为当前BASE_VALUE,并且该过程继续。在下面的示例中,数据集第三行中的第二个“苹果酱”值不应被标记,这说明我需要以某种方式存储第一行的值,并能够将其与第三行进行比较。这就是为什么使用滞后值不起作用,为什么我有BASE_VALUE变量。事实上,我最初试图使用滞后值,直到我意识到这一点。
可复制代码如下:

base_value <- ""
char_vector <- c("applesauce", "apple", "applesauce", "orange", "orange", "banana", "applepie") 

#change char_vector to a dataframe, the lastone column isn't completely necessary
df = data.frame(drug = char_vector) %>% 
mutate(lastone = lag(drug))

test_func <- function(row, output){
if (is.na(row[2])){
   #this is the first observation - set the drug value as BASE_VALUE
   base_value <<- row[1]
   return("Y")
 }else if (!is.na(row[2]) & row[1] != base_value & !grepl(row[1], base_value, fixed = TRUE)) {
   base_value <<- row[1]
   return("Y")
 }else {
   return("N")
 }
}

switches <- apply(df, 1, test_func)
cbind(df, switches = switches)

字符串
上面试过了,它工作。但想加快速度

qojgxg4l

qojgxg4l1#

[This在OP编辑测试数据之前发布了答案。
你把事情弄得太复杂了,lagstr_detect的合理组合可以给予你想要的东西,而不会产生循环。
通过修改示例的最后一行来获取一些测试数据:

original <- cbind(df, switches = switches)

字符串
解决问题

library(tidyverse)

suggested <- df %>% 
  mutate(
    switches = ifelse(
      row_number() == 1, 
      "Y", 
      ifelse(
        str_detect(
          lag(drug), 
          drug
        ), 
        "N", 
        "Y"
      )
    )
  )
identical(suggested$switches, original$switches)
[1] TRUE


你的例子还不够大,不足以让基准测试变得明智,但这可能比循环更快。一个基本的R解决方案可能更快。(尽管,恕我直言,以牺牲可读性为代价。)你应该在真实的数据集上进行测试,以确定哪一个在生产中可能是最好的。
对于基准测试,考虑microbenchmark

n53p2ov0

n53p2ov02#

您可以使用purrr包中的accumulate来跟踪base_value,然后检查其中的更改:

library(purrr)
library(dplyr)
char_vector <- c("applesauce", "apple", "applesauce", "orange", "orange", "banana", "applepie")
    
new_base <- function(old_base, value) {
  if (grepl(value, old_base, fixed = TRUE)) {
    return(old_base)
  } else {
    return(value)
  }
}

tibble(X = char_vector) %>%
mutate(base_value = accumulate(X, new_base),
       changed = ifelse(base_value != lag(base_value, default = ""),
                        "Y", "N"))

个字符
accumulate中,函数返回的值作为第一个参数被送入下一次迭代,并且.

6yjfywim

6yjfywim3#

也许我们根本不需要滞后向量。我们可以把grepl逻辑放在ifelse函数中,然后把它放在acc中,累加Reduce。当我们用它来做factor时,我们可以利用底层的整数结构来计算diff。在基数不变的情况下,我们得到FALSE,在这里它做了TRUE。将+ 1添加到它允许我们很好地子集化向量c('N', 'Y')

> base <- function(x, y) ifelse(grepl(y, x, fixed=TRUE), x, y)
> char_vector |> 
+   as.data.frame() |> 
+   transform(
+     switches=
+       c('N', 'Y')[
+         1L + (c(1, diff(as.factor(Reduce(fun, char_vector, acc=TRUE)))) != 0)]
+   )
  char_vector switches
1  applesauce        Y
2       apple        N
3  applesauce        N
4      orange        Y
5      orange        N
6      banana        Y
7    applepie        Y

字符串

  • 数据类型:*
> dput(char_vector)
c("applesauce", "apple", "applesauce", "orange", "orange", "banana", 
"applepie")

相关问题