mr.T's questions

我有长格式的数据

library(tidyverse)
n=3
set.seed(1)
d <- tibble(y=sample(0:1,n,T), 
            x1=sample(1:5,n,T),
            x2=sample(1:5,n,T),
            x3=sample(1:5,n,T))
d_long <- d |> pivot_longer(!y) 

# add new row with new variable x4
d_long_new <- q |> bind_rows(tibble(y=1,name="x4",value=10))

。

d_long_new


# A tibble: 10 x 3
       y name  value
   <dbl> <chr> <dbl>
 1     0 x1        1
 2     0 x2        3
 3     0 x3        3
 4     1 x1        2
 5     1 x2        2
 6     1 x3        1
 7     0 x1        5
 8     0 x2        3
 9     0 x3        5
10     1 x4       10

我如何将数据转换为宽格式以获得此结果？

 A tibble: 4 x 5
      y    x1    x2    x3    x4
  <dbl> <int> <int> <int> <dbl>
1     0     1     3     3    NA
2     1     2     2     1    NA
3     0     5     3     5    NA
4     1    NA    NA    NA    10

当我尝试应用pivot_wider（）函数时，我得到了一些与我预期不同的结果

d_long_new |> pivot_wider(names_from = name, values_from = value)

。

# A tibble: 2 x 5
      y x1        x2        x3        x4       
  <dbl> <list>    <list>    <list>    <list>   
1     0 <dbl [2]> <dbl [2]> <dbl [2]> <NULL>   
2     1 <dbl [1]> <dbl [1]> <dbl [1]> <dbl [1]>

我有两个具有不同列和不同行大小的数据框

library(tidyverse)

tb1 <- tibble(id= 1:10,
              a= 1:10,
              b=11:20)

tb2 <- tibble(id= 1:5,
               q= 1:5,
               z= 11:15)

我可以轻松地通过id按键组合它们

full_join(tb1, tb2, by = "id")

。

# A tibble: 10 x 5
      id     a     b     q     z
   <int> <int> <int> <int> <int>
 1     1     1    11     1    11
 2     2     2    12     2    12
 3     3     3    13     3    13
 4     4     4    14     4    14
 5     5     5    15     5    15
 6     6     6    16    NA    NA
 7     7     7    17    NA    NA
 8     8     8    18    NA    NA
 9     9     9    19    NA    NA
10    10    10    20    NA    NA

如果我没有带有键的列并且不想在每个数据框中提前创建它，我该怎么做呢？

tb1 <- tibble(a= 1:10,
              b=11:20)

tb2 <- tibble(q= 1:5,
              z= 11:15)

有什么优雅的解决方案吗？不要这么笨重

tb1 %>%
  mutate(row = row_number()) %>%
  left_join(
    tb2 %>% mutate(row = row_number()),
    by = "row"
  ) %>%
  select(-row)

我有一个免费大小的向量列表

set.seed(1)
dat <- lapply(1:10, \(x) sample(letters, size = sample(1:10,1), replace = T))

dat

[[1]]
[1] "d" "g" "a" "b" "w" "k" "n" "r" "s"

[[2]]
[1] "u"

[[3]]
[1] "j" "v" "n" "j" "g"

[[4]]
[1] "o" "u" "e" "i" "y" "n" "e" "e" "b"

[[5]]
 [1] "y" "l" "o" "a" "t" "c" "f" "j" "j" "f"

有哪些方法可以制作像这样的密集矩阵，但效率更高？我还想保存示例中的列名称

library(arules)
as(transactions(dat), "matrix")


          a     b     c     d     e     f     g     h     i     j     k     l     m
 [1,]  TRUE  TRUE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE  TRUE FALSE FALSE
 [2,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
 [3,] FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE
 [4,] FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE
 [5,]  TRUE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE  TRUE FALSE  TRUE FALSE
 [6,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE
 [7,] FALSE FALSE FALSE FALSE FALSE  TRUE FALSE  TRUE FALSE FALSE FALSE  TRUE FALSE
 [8,] FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE
 [9,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE
[10,]  TRUE FALSE FALSE FALSE FALSE  TRUE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE
          n     o     r     s     t     u     v     w     x     y     z
 [1,]  TRUE FALSE  TRUE  TRUE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE
 [2,] FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE
 [3,]  TRUE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE
 [4,]  TRUE  TRUE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE  TRUE FALSE
 [5,] FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE  TRUE FALSE
 [6,] FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE  TRUE  TRUE
 [7,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE FALSE
 [8,] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE  TRUE FALSE  TRUE
 [9,] FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
[10,]  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE

这是 аrules 包中的示例，未针对我的目的进行优化

我有一个日期框架，其中有一列包含代码行。

f1 <- 'paste0("f","q","D",collapse = "")'
f2 <- "q <- rep(NA,10) 
       for(i in 1:10){
       q[i] <- 5+i
       } 
       q"

df <- data.frame(code=c(f1,f2), n=1:2 , lg=c(TRUE,FALSE))

代码可以运行

eval(str2expression(df$code[1]))
eval(str2expression(df$code[2]))

如何正确地将其保存在 a 中csv，然后读取此帧，以便可以再次运行此代码

pth <- "C:\\Users\\....\\Desktop\\f.csv"

# how to correctly save
write.csv(m, pth, row.names = F, quote = F)

# how to correctly read
df2 <- read.csv(pth)

# so the code can be run again
eval(str2expression(df2$code[1]))
eval(str2expression(df2$code[2]))

我有一些数据

set.seed(1)
n <- 100
df <- data.frame(
  x = sample(1:30, n, replace = T),
  y = sample(1:30, n, replace = T),
  z = sample(1:30, n, replace = T)
)

和带有表达式的向量，它们可能不同。

rules <- c("df$x[i] < df$y[i-2] - df$x[i]", 
           "df$y[i] >= mean(df$x)",
           "df$y[i] == 20",
           "df$z[i-30] >= df$x[5]",
           "df$y[i-5] == 16",
           "df$x[10] > sd(as.matrix(df[(i-5):i,]))")

接下来，我有一个函数可以顺序搜索第一个表达式的触发，然后是第二个表达式，依此类推

seq_rules <- function(df, rules, show=T){
  
ln <- length(rules)
res <- matrix(0,nrow = ln, ncol = 2, dimnames = list(NULL, c("row","res")))
n <- 1

  for(i in 30:nrow(df)){
    if(eval(str2expression(rules[n]))){
      res[n,"row"] <- i
      res[n,"res"] <- 1
      if(show) print( cbind.data.frame(df[i,], rule=rules[n], row=i))
      n <- n+1
    }
    if(n>ln) break
  }
res
}

我想加快我的代码速度。您将如何编写这段代码以使其尽可能快？我也希望您的解决方案在不同的情况下与我的解决方案相同seeds

=========================================

如果规则表示为已评估的函数

Frules <- lapply(rules,\(x) eval(str2expression(paste("function(i) {", x ,"}"))))

然后由于没有eval(str2expression..))循环，我可以获得一点速度

新功能

Fseq_rules <- function(df, rules){
  ln <- length(rules)
  res <- matrix(0,nrow = ln, ncol = 2, dimnames = list(NULL, c("row","res")))
  n <- 1
for(i in 30:nrow(df)){
    if(rules[[n]](i)){
        res[n,"row"] <- i
        res[n,"res"] <- 1
        n <- n+1
      }
    if(n>ln) break
  }
  res
}

microbenchmark::microbenchmark(Fseq_rules(df, Frules),
                                seq_rules(df, rules,show = F),times = 100)
Unit: milliseconds
                           expr      min       lq     mean   median       uq      max neval
          Fseq_rules(df, Frules) 1.083315 1.118951 1.283135 1.156011 1.247808 5.601309   100
 seq_rules(df, rules, show = F) 2.495045 2.545790 2.779712 2.607938 2.861662 6.243315   100

我有一些数据

set.seed(1)
n <- 100
df <- data.frame(
  x = sample(1:30, n, replace = T),
  y = sample(1:30, n, replace = T),
  z = sample(1:30, n, replace = T)
)

我还有函数列表，函数的数量可以是任意的，函数的复杂性也可以（在这个例子中我故意让它们变得简单）

rules <- list(function(i) df$x[i]==26,
              function(i) df$y[i]==17,
              function(i) df$z[i]==14)

接下来，我有一个函数，它顺序搜索第一个函数的触发，然后是第二个函数，依此类推

# search sequence
# first x[i]==26 then y[i]==17 then z[i]==14
find_rules <- function(df, rules){
ln <- length(rules)
n <- 1
res <- matrix(0,nrow = ln, ncol = 2, dimnames = list(NULL, c("row","res")))
for(i in 1:nrow(df)){
  if(rules[[n]](i)){
    res[n,"row"] <- i
    res[n,"res"] <- 1
    n <- n+1
  }
  if(n==ln+1) break
}
return(res)
}

我想 find_rules在不改变上面代码中任何内容的情况下尽可能地加速功能。我还想在您的解决方案的计算中以及find_rules不同的情况下获得完整的身份seeds()

假设我有一个巨大的文件，分为许多部分，我可以用箭头读取

X <- iris
library(arrow)
# bigX a large file that is stored in chunks on disk out of memory
bigX <- arrow_table(X)

按某个值过滤后Sepal.Width == 3.8，我得到了一些我需要的数据

library(dplyr)
 bigX %>% 
  filter(Sepal.Width == 3.8) %>% 
  collect()

..

 Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
1          5.7         3.8          1.7         0.3    setosa
2          5.1         3.8          1.5         0.3    setosa
3          5.1         3.8          1.9         0.4    setosa
4          5.1         3.8          1.6         0.2    setosa
5          7.7         3.8          6.7         2.2 virginica
6          7.9         3.8          6.4         2.0 virginica

我的问题是我还想从整个巨大的选择中获取真实的行索引。就像这个例子一样。

X[X$Sepal.Width==3.8,]

..

    Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
19           5.7         3.8          1.7         0.3    setosa
20           5.1         3.8          1.5         0.3    setosa
45           5.1         3.8          1.9         0.4    setosa
47           5.1         3.8          1.6         0.2    setosa
118          7.7         3.8          6.7         2.2 virginica
132          7.9         3.8          6.4         2.0 virginica