Ben_89's questions

Gostaria de criar uma nova coluna que calcule uma média cumulativa sobre as 3 primeiras observações de outra coluna e preencha o resultado no restante da nova coluna. Por exemplo, digamos que meu data frame tenha 10 linhas e a média cumulativa das 3 primeiras observações foi 64, eu gostaria, de preferência, que o valor 64 fosse preenchido para as linhas 4 a 10.

Esperando por uma solução que possa ser executada em dplyr.

library(tidyverse)

set.seed(1)
dat <- data.frame(var1 = round(rnorm(10, 100, 20)))

dat <- dat %>%
  mutate(var1_mean = cummean(head(var1, 3)))

Estou familiarizado com a lag()função em R, mas meu caso de uso exclusivo para ela desta vez é que gostaria de executar uma média móvel rollapplyr()que não inclua as sete linhas de dados imediatamente anteriores.

Isso é possível se eu ajustar de alguma forma o código que parece não funcionar?

library(tidyverse)
library(zoo)

stack <- data.frame(
  date = seq(Sys.Date(), Sys.Date() - 99, -1),
  var1 = round(rnorm(100, 8000, 500))
  )

lag <- stack %>%
  mutate(var1_lag = lag(rollapplyr(var1, 28, mean, partial = TRUE) - 28))

Tenho um conjunto de dados que contém várias variáveis ​​de interesse. O que eu gostaria de fazer é calcular uma média móvel com a rollapplyr()função do zoopacote para cada uma delas como colunas adicionais, mas a ressalva é que eu gostaria de usar uma largura de janela diferente ( width =) dependendo da coluna. Também desejo evitar pivotar meus dados para o formato longo.

library(tidyverse)
library(zoo)

rolling_f <- function(x, wdw, fun){ rollapplyr(x, wdw, fun, partial = TRUE) }

set.seed(1)
ex <- data.frame(
  var1 = rnorm(20, 8000, 500),
  var2 = rnorm(20, 8000, 500),
  var3 = rnorm(20, 8000, 500),
  var4 = rnorm(20, 8000, 500),
  var5 = rnorm(20, 8000, 500),
  var6 = rnorm(20, 8000, 500),
  var7 = rnorm(20, 8000, 500),
  var8 = rnorm(20, 8000, 500)
  ) %>%
  mutate(
    across(
      .cols = starts_with("var"),
      .fns = ~rolling_f(.x, 5, mean),
      .names = "{.col}_roll"
      )
    )

Meu código até agora calcula a mesma largura de janela (5) para cada coluna, mas espero que alguém possa me ajudar a definir minha função personalizada melhor para que a janela possa ser 3 para var1:var3, 5 para var4:var5, e 6 para var6:var8, como um exemplo. Presumo que isso simplesmente exigirá algum código adicional na rolling_f()função personalizada que comecei.

Tenho um quadro de dados que contém cerca de 15 variáveis ​​de interesse e pretendo preencher condicionalmente os valores com base em alguns critérios usando a pill_buttons()função no reactablefmtrpacote.

Os dados fictícios abaixo tentam simular meus dados reais, mas para o propósito deste post, eu apenas usei 3 variáveis ​​em vez de 15 ou mais. var1_z, var2_zetc. são pontuações z que correspondem à coluna homônima. Eu então crio colunas adicionais que fazem referência à cor que eu gostaria que os respectivos valores fossem coloridos na tabela.

library(tidyverse)
library(reactable)
library(reactablefmtr)

cell_bg <- function(x){
  case_when(
    x > 1.5 ~ "red",
    x < -1.5 ~ "lightblue",
    .default = "transparent"
    )
  }

set.seed(1)
ex <- data.frame(
  date = seq(Sys.Date(), Sys.Date() - 9, -1),
  var1 = round(rnorm(10, 8000, 500)),
  var2 = round(rnorm(10, 500, 50)),
  var3 = round(rnorm(10, 100, 20)),
  var1_z = round(runif(10, -3, 3), 2),
  var2_z = round(runif(10, -3, 3), 2),
  var3_z = round(runif(10, -3, 3), 2)
  ) %>%
  mutate(
    across(
      .cols = var1_z:var3_z,
      .fns = cell_bg,
      .names = "{.col}_pal"
      )
    )

Estou familiarizado com o uso da pill_buttons()função, conforme exibido abaixo no meu conjunto de dados fictício. No entanto, é repetitivo e tedioso completar cada função para cada variável, como fiz abaixo, bem como codificar colDef(show = FALSE)para cada coluna que não desejo exibir na saída final. Como tenho certeza de que você pode entender, ter que repetir essas etapas para muito mais colunas parece exagero.

reactable(ex,
          highlight = TRUE,
          pagination = FALSE,
          defaultColDef = colDef(
            align = "center",
            headerVAlign = "center",
            html = TRUE
            ),
          columns = list(
            date = colDef(sticky = "left"),
            var1 = colDef(cell = pill_buttons(ex, color_ref = "var1_z_pal")),
            var2 = colDef(cell = pill_buttons(ex, color_ref = "var2_z_pal")),
            var3 = colDef(cell = pill_buttons(ex, color_ref = "var3_z_pal")),
            var1_z = colDef(show = FALSE),
            var2_z = colDef(show = FALSE),
            var3_z = colDef(show = FALSE),
            var1_z_pal = colDef(show = FALSE),
            var2_z_pal = colDef(show = FALSE),
            var3_z_pal = colDef(show = FALSE)
            )
          )

Sei que posso usar outros pacotes de tabela, como kableExtraesse, que podem simplificar meu fluxo de trabalho, mas estou decidido a usar reactablefmtre a pill_buttons()função, pois gosto da estética. Espero que alguém tenha uma solução onde eu possa tornar meu código para criar a saída desejada mais eficiente sem ter que escrever muitas, muitas linhas.

Eu tenho um quadro de dados (exemplo abaixo) que gostaria de colocar em uma tabela HTML usando o pacote kableExtraem R. Uma das minhas colunas ( pos) é uma variável de agrupamento e gostaria de usá-la para adicionar rótulos de linhas de grupo na mesa. Sei que posso fazer isso com a pack_rows()função from kableExtra, mas gostaria de saber se existe alguma forma de fazer isso de forma dinâmica. Por exemplo, tenho três valores de string exclusivos posno conjunto de dados de exemplo e poderia facilmente chamar três pack_rows()funções e fornecer os respectivos índices (primeiro valor e a linha média). No entanto, nem sempre posso ter trêsposstrings (por exemplo, às vezes posso ter duas, quatro ou cinco), e o número de linhas/observações para cada grupo mudará em meu conjunto de dados real. Como gostaria de usar isso para gerar um relatório, espero que haja um truque para automatizar esse processo de alguma forma. Obrigado.

library(tidyverse)
library(kableExtra)

set.seed(10)
name <- paste("Name", LETTERS[1:15])
var1 <- rep(rnorm(15, 100, 20))
var2 <- rep(rnorm(15, 100, 20))
var3 <- rep(rnorm(15, 100, 20))
var4 <- rep(rnorm(15, 100, 20))
pos <- c(rep("DEF", 5), rep("MID", 5), rep("FWD", 5))

df <- data.frame(name, var1, var2, var3, var4, pos)

agg_df <- bind_rows(
  df,
  df %>% group_by(pos) %>%
    summarise_at(vars(var1:var4), mean) %>%
      mutate(name = "mean")
  ) %>% 
  arrange(pos, name)

agg_df %>%
  kbl() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                fixed_thead = TRUE)