mr.T's questions

Eu tenho esses dados em formato longo

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

Como posso converter os dados para formato amplo para obter esse resultado?

 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

Quando tento aplicar a função pivot_wider() obtenho algo diferente do que esperava

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]>

Eu tenho dois dataframes com colunas e tamanhos de linhas diferentes

library(tidyverse)

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

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

Posso combiná-los facilmente por idchave

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

Como posso fazer o mesmo se não tenho uma coluna com chave e não quero criá-la antecipadamente em cada dataframe.

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

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

existe alguma solução elegante? Não tão volumoso assim

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

Eu tenho uma lista de vetores de tamanho livre

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"

Quais são algumas maneiras de fazer uma matriz densa como esta, mas de forma mais eficiente? Também gostaria de salvar os nomes das colunas como no exemplo

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

Este é um exemplo do pacote аrules e não está otimizado para meus propósitos

Eu tenho um quadro de data com uma coluna contendo linhas de código.

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))

o código pode ser executado

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

como salvá-lo corretamente em um csve depois ler este quadro para que este código possa ser executado novamente

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]))

Eu tenho alguns dados

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)
)

e vetor com expressões, elas podem ser diferentes.

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,]))")

A seguir, tenho uma função que busca sequencialmente o acionamento da primeira expressão, depois da segunda e assim por diante

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
}

Eu gostaria de acelerar meu código. Como você escreveria esse código para torná-lo o mais rápido possível? Também gosto que sua solução seja idêntica à minha em diferentesseeds

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

se as regras são representadas como funções já avaliadas

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

Então posso ganhar um pouco de velocidade devido à ausência eval(str2expression..))no loop

Nova função

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

eu tenho alguns dados

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)
)

E também tenho uma lista de funções, o número de funções pode ser qualquer, a complexidade das funções também (eu as simplifiquei intencionalmente para este exemplo)

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

A seguir, tenho uma função que busca sequencialmente o acionamento da primeira função, depois da segunda e assim por diante

# 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)
}

Gostaria de acelerar find_rulesa função tanto quanto possível sem alterar nada no código apresentado acima. Gostaria também de identidade completa nos cálculos da sua solução e find_rulesnos diferentesseeds()

vamos imaginar que tenho um arquivo enorme dividido em vários pedaços que posso ler com uma seta

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

depois de filtrar por algum valor Sepal.Width == 3.8, recebo alguns dos dados que preciso

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

Meu problema é que também quero obter índices de linhas reais de uma seleção enorme. como neste exemplo.

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