Jaken's questions

Tenho uma grande pilha raster que é um monte de grupos empilhados juntos. A única coisa que diferencia os grupos é o nome da camada, que começa consistentemente com o mesmo prefixo. Gostaria de separar esses grupos em pilhas separadas, com base no nome da camada. Sei que posso usar subset()para extrair um conjunto específico de camadas, com base no número da camada ou no nome , mas isso exige que eu identifique manualmente cada grupo separadamente. Existe alguma maneira de fazer isso usando um índice, talvez de forma semelhante a como você pode usar um índice para agrupar em terra::tapp()?

library(terra)

#create sample data
s1 <- rast(nrow=4, ncol=3, nlyrs=5)
values(s1) <- runif(ncell(s1) * dim(s1)[3])
names(s1) <- c('m1', 'm2', 'm3', 'm4', 'm5')

s2 <- rast(nrow=4, ncol=3, nlyrs=5)
values(s2) <- runif(ncell(s2) * dim(s2)[3])
names(s2) <- c('n1', 'n2', 'n3', 'n4', 'n5')

s <- c(s1, s2)

#create index of the different layers - can I use this to separate the groups?
lyr_names <- names(s)
idx <- substr(lyr_names, 1, 1)

#manual subset by position
m <- subset(s, 1:5)
n <- subset(s, 6:10)

#manual subset by names
names_m <- lyr_names[grep("m.*", lyr_names)]
names_n <- lyr_names[grep("n.*", lyr_names)]

m <- subset(s, names_m[names_m %in% names(s)])
n <- subset(s, names_n[names_n %in% names(s)])

Tenho duas pilhas raster, ambas representando uma sequência de meses. Stack1 é uma sequência repetida em vários anos (por exemplo, Jan, Fev, Março, ..., Jan, Fev, Março, ..., Jan, Fev, Março, ...) e Stack2 é uma única sequência de valores de referência para esses mesmos meses (por exemplo, Jan, Fev, Março, ...). Quero executar uma operação combinando as duas pilhas usando seu índice comum - por exemplo, Stack1/Stack2, mas específico para o índice (então Stack1Jan1/Stack2Jan, Stack1Feb1/Stack2Feb, ... Stack1Jan2/Stack2Jan).

Tenho quase certeza de que isso é possível usando um dos métodos baseados em apply (app, tapp, rapp, etc.), mas apesar de gastar muito tempo na documentação, não consigo descobrir qual. Sei que usando tapp, posso aplicar uma função a diferentes camadas do raster usando um índice, como no exemplo abaixo, mas não tenho certeza de como fazer esse mesmo índice aplicar ao envolver uma segunda pilha.

#sample data
r <- rast(ncols=9, nrows=9)
values(r) <- 1:ncell(r)
s <- c(r, r, r, r, r, r)
s <- s * 1:6
Stack1 <- c(s, s, s)
Stack2 <- rast(ncols=9, nrows=9, nlyrs=6)
values(Stack2) <- rep(1, ncell(Stack2)*6)
Stack2 <- Stack2 * 1:6

#tapp lets you apply an index for layers within a single stack
idx <- rep(1:6, 3)
s1_mean <- tapp(Stack1, idx, fun=mean)

# what I'd like would be something like:
myfun <- function(x) {x/Stack2[[idx]]}
s1_out <- tapp(Stack1, index=idx, fun=myfun)

Eu sei que poderia fazer isso subdividindo cada raster em seus meses e então fazendo o cálculo dessa forma, mas tenho certeza de que há uma maneira mais eficiente!

Às vezes, escrevo funções que envolvem renomear/reetiquetar muitas variáveis ​​em lugares diferentes, usando um reetiquetador. O reetiquetador é usado em vários contextos, tanto diretamente no meu código (por exemplo, para títulos) quanto passado para outras funções (por exemplo, facet_wrap). Isso é bom para usos típicos:

library(ggplot2)
library(dplyr)

plotfcn <- function(df, x, y, facet, fancy_labs){
  # Strings of x & y (for axis titles)
  xStr <- fancy_labs(deparse(substitute(x)))
  yStr <- fancy_labs(deparse(substitute(y)))
  
  #base plot
  p <- ggplot(df, aes({{x}}, {{y}})) + 
    geom_point()
  
  #add facets (with labels) and axis labels
  p + facet_wrap(vars({{facet}}), labeller=fancy_labs) +
    labs(x=xStr, y=yStr)
}

mylabs <- as_labeller(c(
  'compact' = 'Small Family Car',
  'midsize' = 'Medium Family Car',
  'minivan' = 'For the Kids',
  'pickup' = 'For the Stuff',
  'displ' = 'Engine Displacement (L)',
  'hwy' = 'Highway Mileage (mpg)'))

classlist <- c('compact', 'midsize', 'minivan', 'pickup')

mpg_lim <- mpg %>% filter(class %in% classlist) 

mpg_lim %>% plotfcn(displ, hwy, class, fancy_labs = mylabs)

Agora eu gostaria de tornar o argumento labeller opcional. Envolver qualquer coisa que envolva rótulos em uma instrução if/else é fácil:

plotfcn <- function(df, x, y, facet, fancy_labs=NULL){
  # Strings of x & y (for axis titles)
  if(!is.null(fancy_labs)) {
    xStr <- fancy_labs(deparse(substitute(x)))
    yStr <- fancy_labs(deparse(substitute(y)))
  } 
  
  #base plot
  p <- ggplot(df, aes({{x}}, {{y}})) + 
    geom_point() 
  
  #optional: add labels using labeller
  if(!is.null(fancy_labs)) { 
    p + 
      facet_wrap(vars({{facet}}), labeller=fancy_labs) +
      labs(x=xStr, y=yStr)
    } else { 
      p + facet_wrap(vars({{facet}}))  
    }
}

mpg_lim %>% plotfcn(displ, hwy, class, fancy_labs = mylabs)

mpg_lim %>% plotfcn(displ, hwy, class)

No entanto, se possível, gostaria de evitar colocar o argumento facet_wrap() na instrução if/else. (No meu código real, ele já está em uma sequência if/else, então adicionar este if/else adicional adicionará muitas ramificações e copiar/colar repetidamente, o que é trabalhoso de trabalhar.) Esta resposta sugere usar uma construção ellipse para passar o argumento labeller para facet_wrap, o que funciona muito bem - exceto que não consigo descobrir como chamar a mesma função labeller para os rótulos do eixo. Eu precisaria passar o mesmo argumento no meu código duas vezes com dois nomes diferentes, como mostrado abaixo, ou há alguma maneira de chamar o argumento labeller por meio da construção ellipses e independentemente no meu código?

plotfcn <- function(df, x, y, facet, fancy_labs=NULL, ...){
  # Strings of x & y (for axis titles)
  if(!is.null(fancy_labs)) {
    xStr <- fancy_labs(deparse(substitute(x)))
    yStr <- fancy_labs(deparse(substitute(y)))
  } 
  
  #base plot - calls labeller using ...
  p <- ggplot(df, aes({{x}}, {{y}})) + 
    geom_point() +
    facet_wrap(vars({{facet}}), ...)
  
  #optional: add labels using labeller
  if(!is.null(fancy_labs)) { 
    p + labs(x=xStr, y=yStr)
    } else { 
      p
    }
}

#this works, but involves calling the same parameter (mylabs) twice under two different names, which is annoying
mpg_lim %>% plotfcn(displ, hwy, class, fancy_labs = mylabs, labeller=mylabs)
mpg_lim %>% plotfcn(displ, hwy, class)

Se eu configurar a função com um argumento labeller function(df, x, y, facet, labeller = NULL, ...), a construção ellipsis não dispara, e minhas facetas não são rotuladas. Mas se eu configurá-la apenas com as ellipses function(df, x, y, facet, ...), não posso verificar sua presença usando is.null()ou missing()para disparar minhas instruções if . Existe alguma maneira de fazer com que as instruções if reconheçam a presença/ausência do argumento labeller?

Tenho uma função personalizada que chama ggplot. Gostaria de tornar um dos argumentos ggplot opcional - por exemplo, alterando a cor de geom_point. Conheço duas maneiras de fazer isso, conforme mostrado abaixo; uma é especificar um padrão se o argumento opcional não for fornecido, e a outra é envolver toda a função ggplot (aqui, geom_point()) em uma instrução if. Nenhuma delas é ideal no meu caso - o argumento que estou usando não tem um padrão fácil, e a própria função ggplot já está em uma instrução if/else if/else no meu código, o que significa que eu acabaria com muitas instruções if aninhadas. Existe alguma maneira de passar um argumento dizendo essencialmente, "ignore este argumento, use seu comportamento padrão"?

Aqui está um exemplo muito básico das duas maneiras que funcionam:

library(ggplot2)
library(dplyr)

# Opt 1 - specify a default; not viable in my actual problem due to lack of default

fun_default <- function(df, x, y, color="red"){
  p <- df %>%
    ggplot(aes({{x}}, {{y}})) + 
    geom_point(color=color)
  
  p
}

# Opt 2 - use an if statement for the whole argument
# workable but cumbersome in my actual problem, since I'd have to repeat the if/else multiple times throughout the code

fun_if <- function(df, x, y, color=NULL){
  p <- df %>%
    ggplot(aes({{x}}, {{y}})) +
    {if(is.null(color)) { geom_point() }
    else { geom_point(color = color)}}
  p
}

fun_default(mtcars, wt, mpg, color="blue")
fun_if(mtcars, wt, mpg, color="blue")
fun_if(mtcars, wt, mpg)

O que eu gostaria de fazer é aninhar uma declaração if dentro da chamada geom_point, ou definir um argumento de cor que seria o padrão do ggplot, sem especificar o padrão por conta própria. Na minha cabeça, isso seria algo como um dos seguintes (obviamente, nenhum desses realmente funciona):

# if statement inside of geom_point()
fun_wish1 <- function(df, x, y, color=NULL){
  p <- df %>%
    ggplot(aes({{x}}, {{y}})) +
    geom_point( {if(!is.null(color)) {color=color}} )
  p
}

# somehow tell geom_point to ignore color or use its default for color
fun_wish2 <- function(df, x, y, color=NULL){
  if(is.null(color)) {color = NA}
  p <- df %>%
    ggplot(aes({{x}}, {{y}})) +
    geom_point(color=color)
  p
}

Tenho uma função personalizada que recebe como entrada um quadro de dados e, em seguida, uma seleção de colunas desse quadro de dados, assim:

library(dplyr)
df <- data.frame(x = c(1, 2, 3, 4, 5), y = c(11, 12, 13, 14, 15))

sample_fun <- function(df, x, y) {
  df <- df %>% 
    mutate(z = {{x}} * {{y}})
  }

df_out <- sample_fun(df, x, y)

Gostaria de tornar uma das colunas do data frame opcional e, então, fazer a função testar sua presença usando !if.null(). Se isso fosse um objeto, em vez de uma coluna do data frame, eu faria isso:

sample_fun <- function(df, x, y = NULL) {
  if(!is.null(y)) {
    df <- df %>% 
      mutate(z = {{x}} * y)
  }
  else(df <- df %>%
         mutate(z = {{x}}))
}

df_out <- sample_fun(df, x) 
df_out2 <- sample_fun(df, x, y)

No entanto, não consigo descobrir como verificar a presença da coluna de dados. Ambos if(!is.null(y))e if(!is.null({{y}}))retornam Error: object 'y' not found. Qual é a melhor maneira de verificar a presença de y, quando y é uma coluna de data frame em vez de um objeto independente?

Ao usar uma função labeller no ggplot2, é possível aplicá-la somente quando o valor original for encontrado na tabela de consulta? No exemplo abaixo, estou usando as_labeller()para renomear algumas das classes de carros. Qualquer coisa que não esteja na tabela de consulta assume o padrão "NA". Gostaria que mantivesse seu nome original. Isso é possível?

library(ggplot2)

#base plot without any labels
p <- ggplot(mpg, aes(displ, hwy)) + geom_point()
p + facet_wrap(~class)

#add fancy labels - but only for some classes
fancy_labs <- as_labeller(c('2seater' = 'Seats Two!', 'compact' = "Small Family Car"))
p + facet_wrap(~class, labeller = fancy_labs)

Gostaria que os cabeçalhos do segundo gráfico fossem: "Assentos dois!" "Carro pequeno para família", "médio", "minivan" (etc.)

Estou tentando usar o tidyterra scale_*_whitebox_b()para agrupar valores contínuos usando quebras personalizadas que são distribuídas de forma desigual, para enfatizar a diferença nos valores baixos. Estou tendo problemas porque a escala agrupada redimensiona automaticamente a paleta de cores para corresponder ao tamanho das minhas quebras, o que significa que os valores baixos na parte inferior do intervalo são coloridos de forma semelhante e difíceis de distinguir.

library(ggplot2)
library(terra)
library(tidyterra)

#sample data, with some sparse high values
r <- rast(nrows=10, ncols=10)
values(r) <- abs(rnorm(100))
r[17] <- 12
r[22] <- 17
r[72] <- 7
breaks=c(0, 0.25, 0.5, 1, 2, 5, 10, 20)

ggplot() +
  geom_spatraster(data=r) +
  scale_fill_whitebox_b("viridi", 
                        breaks=breaks, direction=-1)

A documentação para scale_fill_whitebox_b()aponta para os construtores de escala de binning ggplot subjacentes , que tem um argumento rescaler, mas não consigo descobrir como chamá-lo para scale_fill_whitebox. Com ggplot scale_fill_steps, você pode fazer isso usando values ​​e limits :

ggplot(r) +
  geom_raster(aes(x=x, y=y, fill=lyr.1)) + 
  scale_fill_stepsn(colors=terrain.colors(7),
                    breaks=breaks,
                    values = scales::rescale(breaks),
                    limits = range(breaks))

Mas scale_fill_whiteboxnão aceita "values"argumentos, e não tive sorte em brincar com o argumento do rescaler.

Gostaria de replicar as cores que obtenho quando uso os mesmos parâmetros com um gráfico de contorno; aqui, a paleta de cores é distribuída uniformemente entre os intervalos especificados.

ggplot() +
  geom_spatraster_contour_filled(data=r, breaks=breaks) +
  scale_fill_whitebox_d("viridi", direction=-1)

Tenho uma série de dataframes, cada um dos quais contém uma coluna de nome e, em seguida, uma coluna de texto. Gostaria de encontrar duplicatas no texto e, em seguida, gerar uma lista de todos os nomes que estão associados à duplicata. Posso chegar a obter uma lista das duplicatas de texto e o número de vezes que cada duplicata ocorre, mas estou com dificuldades para encontrar uma maneira de obter a lista de nomes associados. Aqui está um exemplo reproduzível:

#two separate data frames with name/string
books1 <- data.frame(
  name=rep("Ellie", 4),
  book= c("Anne of Green Gables", "The Secret Garden", "Alice in Wonderland", "A Little Princess"))

books2 <- data.frame(
  name=rep('Jess', 6),
  book=c("Harry Potter", "Percy Jackson", "Anne of Green Gables", "Chronicles of Narnia", "Redwall", "A Little Princess"))

#combine into single data frame
books <- bind_rows(books1, books2)

#identify repeats
repeatbooks <- books %>% group_by(book) %>% summarize(n=n())

Isso me dá:

  book                     n
1 A Little Princess        2
2 Alice in Wonderland      1
3 Anne of Green Gables     2
4 Chronicles of Narnia     1
5 Harry Potter             1
6 Percy Jackson            1
7 Redwall                  1
8 The Secret Garden        1

O que eu gostaria é algo como:

  book                     n     name
1 A Little Princess        2     Ellie, Jess
2 Alice in Wonderland      1     Ellie
3 Anne of Green Gables     2     Ellie, Jess

Eu esperava fazer algo assim, mas isso cria várias linhas, em vez de agrupar os nomes em uma única linha

#identify repeats while catching associated names - doesn't group into single column
repeatbooks <- books %>% group_by(book) %>% summarize(n=n(), names=c(paste0(name), ', '))

Estou trabalhando com um conjunto de dados que inclui dados raster que estou combinando com mapas do rnaturalearth. A maior parte do que estou fazendo é manipular os dados raster usando o terra, para fazer coisas como agregação, reprojeção e, em seguida, várias operações raster usando o app (para coisas como tirar a média de várias camadas, etc.).

Para vários propósitos de visualização, às vezes eu quero cortar meus rasters e exibir dados regionais usando ggplot. Cortar o raster em si é fácil usando crop(), mas cortar o objeto sf é um pouco mais difícil. A solução que eu encontrei em tutoriais mais antigos agora gera um erro:

library(sf)
library(rnaturalearth)
world <- ne_countries(scale = "small", returnclass = "sf")

europe <- st_crop(world, xmin = -20, xmax = 45,
                         ymin = 30, ymax = 73)

Error in wk_handle.wk_wkb(wkb, s2_geography_writer(oriented = oriented, :
Loop 0 is not valid: Edge 0 crosses edge 78

Aparentemente, isso é causado pela mudança do espaço plano para a geometria esférica e pode ser resolvido desativando sf_use_s2():

sf_use_s2(FALSE)
europe <- st_crop(world, xmin = -20, xmax = 45,
                         ymin = 30, ymax = 73)

Spherical geometry (s2) switched off
although coordinates are longitude/latitude, st_intersection assumes that they are planar
Warning: attribute variables are assumed to be spatially constant throughout all geometries

Esta vinheta entra em muitos detalhes sobre geometria esférica em sf, mas não tenho certeza se estou captando todas as nuances, e tenho medo de inadvertidamente fazer algo para bagunçar a geometria sem perceber. Em geral, estou trabalhando com dados lat/lon (WGS84), e faço todas as minhas análises com lat/lon, então projeto para mollweide usando coord_sf() apenas para fins de visualização. Estou trabalhando amplamente com dados globais, que ocasionalmente visualizo em escalas mais locais. Então minha pergunta é:

Há algum problema em desligar sf_use_s2() para fins de cortar objetos sf? Devo ligá-lo novamente após executar esta operação?

Estou executando modelos de ajuste linear em uma série de rasters muito grandes. Frequentemente preciso retornar dois ou mais valores do modelo - por exemplo, o coeficiente e seu valor p associado. Em um caso não raster, eu faria uma função que retornasse todos os valores que eu queria como uma lista, assim:

#quick lm function to pull out coefficient and p.value
lm_fun <- function(x, y){
  lm <- lm(x ~ y)
  coef1 <- coef(summary(lm))[2,1]
  pval <- coef(summary(lm))[2,4]
  lm_results <- list(coef1 = coef1, pval = pval)
}

#sample data
dat <- c(runif(100, 2, 5), runif(100, 4, 10), runif(100, 6, 14))
timestep <- 1:length(dat)

lm_results <- lm_fun(dat, timestep)

No entanto, ao trabalhar com dados raster, uma função personalizada é aplicada ao raster por meio de calc (com o pacote raster) ou app (com o pacote terra) e retorna uma camada raster ou SpatRaster. Existe alguma maneira de modificar a função para produzir uma pilha raster, com saídas diferentes (por exemplo, coeficiente, valor p) em camadas diferentes? No momento, estou usando a abordagem abaixo, mas isso significa que estou executando o mesmo cálculo várias vezes para extrair partes diferentes dos resultados, o que é extremamente ineficiente computacionalmente. Estou aberto a usar raster ou terra.

# create three identical RasterLayer objects
r1 <- r2 <- r3 <- raster(nrow=100, ncol=100)
# Assign random cell values
values(r1) <- runif(ncell(r1), min=2, max=5)
values(r2) <- runif(ncell(r2), min=4, max=10) 
values(r3) <- runif(ncell(r3), min=6, max=14)
# combine three RasterLayer objects into a RasterStack
s <- stack(r1, r2, r3)
plot(s)

#calculate number of timesteps
nsteps <- dim(s)[3]
timestep <- 1:nsteps

#functions to calculate linear trend and associated p-value
trendfun <- function(x) { if (is.na(x[1])){ NA } else { lm(x ~ timestep)$coefficients[2]}}
pfun <- function(x) { if (is.na(x[1])){ NA } else { summary(lm(x ~ timestep))$coefficients[2,4]}}

# calculate trend and p-value using raster
library(raster)
s_trend <- calc(s, trendfun)
s_trend_pv <- calc(s, pfun)

#alternatively, calculate using terra package
library(terra)
s_rast <- rast(s)
s_trend <- app(s_rast, fun=trendfun)
s_pvalue <- app(s_rast, fun=pfun)

Estou tentando criar uma função personalizada que usa ggplot facet_wrap, na qual o usuário pode opcionalmente fornecer rótulos. Encapsulei o argumento facet_grid em uma cláusula if/else dependendo se o usuário fornece ou não rótulos, e a função é executada com sucesso. No entanto, ela só funciona se essa cláusula for a chamada final na sequência ggplot; se eu adicionar qualquer outra coisa depois dela (por exemplo, especificando o tema), ela quebra. Obviamente, posso reordenar a função para deixar a chamada facet_wrap no final, mas suspeito que isso significa que estou fazendo algo incorretamente.

Aqui está um exemplo reproduzível:

library(dplyr)
library(ggplot2)

# sample data
data(msleep)
filtered<- msleep %>% filter(conservation %in% c('en', 'vu', 'domesticated'))

# readable labels
fancy_labels_cons <- c('domesticated' = 'Domesticated', 'en' = 'Endangered', 'vu' = 'Vulnerable')
fancy_labels_vore <- c('carni' = 'Carnivore', 'herbi'='Herbivore', 'omni'='Omnivore', 'insecti'='Insectivore')

# function: works as long as if/else clause is the final argument
myfunc_workingversion <- function(df, x, y, facetx, facety, labs=NULL) {
  ggplot(df, aes({{x}}, {{y}})) + 
    geom_point() +
    if(!is.null(labs)) {
        facet_grid(vars({{facetx}}), vars({{facety}}),
                  labeller = as_labeller(labs))
    } else {
        facet_grid(vars({{facetx}}), vars({{facety}}))
    } 
}

#function: no longer works when an additional ggplot argument is added at the end
myfunc2 <- function(df, x, y, facetx, facety, labs=NULL) {
  ggplot(df, aes({{x}}, {{y}})) + 
    geom_point() +
    if(!is.null(labs)) {
        facet_grid(vars({{facetx}}), vars({{facety}}),
                  labeller = as_labeller(labs))
    } else {
        facet_grid(vars({{facetx}}), vars({{facety}}))
    } +
    theme_minimal()
}

#run function - this works
myfunc2(
  filtered, 
  x=sleep_total, 
  y=awake, 
  facetx=conservation, 
  facety=vore, 
  labs=c('domesticated' = 'Domesticated', 'en' = 'Endangered', 
         'vu' = 'Vulnerable', 'carni' = 'Carnivore', 'herbi'='Herbivore',
         'omni'='Omnivore', 'insecti'='Insectivore'))

#run function - this doesn't work
myfunc2(
  filtered, 
  x=sleep_total, 
  y=awake, 
  facetx=conservation, 
  facety=vore
)

Note que ambas as versões das funções funcionam se os laboratórios forem fornecidos; no entanto, a segunda versão quebra se os laboratórios não forem fornecidos. Suspeito que estou fazendo algo errado com o "+". Também estou interessado em saber se há uma maneira mais otimizada ou legível de configurar a entrada opcional aqui.