Блог

Проблема

У меня возникают большие трудности с использованием известного значения внутри функции внутри dplyr . Проблема связана со следующей строкой. Остальное из того, что следует, — это просто данные, которые приводят к проблемному компоненту.

 data <- data %>%
 group_by(Group) %>% 
 bind_cols(as_tibble(rotate2(as.matrix(.)[,1:2], theta = min(.$theta))))
 

Это min(.$theta) моя попытка попытаться найти тета-значение в каждой группе и использовать его. В созданных данных есть столбец (как показано ниже), который содержит это значение. Я хочу взять значение из каждой группы ( Group ) и использовать его с. rotate2 В приведенном ниже примере только две группы, но реальные данные содержат сотни групп. Что я хочу знать: как я могу использовать существующее значение для каждой группы (столбец theta повторяет одно и то же значение для каждой группы).

Есть ли что-то, что я могу заменить min(.$theta) , что сделало бы это? Кажется, что он берет данные из всего столбца, а не берет значение из каждого Group в отдельности.

Данные для решения проблемы

Пакеты — dplyr , plyr , lava

 data <- structure(list(X = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 4.9046, 
6.1424, 7.275, 8.5851, 10.0373, 11.9981, 13.7726, 15.0731, 16.0664, 
18.1945, 21.2666, 24.2093, 26.7119, 28.8037, 30.7135, 32.1351, 
33.1982, 34.2341, 35.7587, 37.2147, 38.4303, 39.625, 40.4596, 
42.0938, 42.7428, 42.7593, 43.5085, 43.7419, 43.5989, 44.0841, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, -14.845, -11.9052, 
-8.7897, -5.8034, -2.6756, 0.3316, 3.4003, 6.5281, 9.6517, 12.804, 
15.9861, 19.1769, 22.2929, 25.4089, 28.3392, 31.0054, 33.1847, 
35.081, 36.7227, 38.1544, 39.1697, 40.049, 40.9647, 41.5014, 
41.8874, 42.1778, 42.3435, 42.2681, 42.3745, 42.4619, NA, NA, 
NA, NA), Y = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, -9.9938, -7.4596, 
-4.8647, -2.2903, 0.3158, 2.9302, 5.7262, 8.7033, 11.8007, 14.9847, 
16.7225, 16.7813, 15.6921, 14.2964, 11.5579, 8.2378, 5.183, 1.5938, 
-2.0712, -5.195, -7.1447, -9.0446, -11.1269, -13.0979, -15.3295, 
-17.1898, -19.4376, -21.4781, -23.8426, -25.6343, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, 8.0113, 9.1826, 9.838, 10.7908, 
11.175, 12.0393, 12.6813, 12.8828, 13.2281, 13.5102, 13.6637, 
13.5493, 12.8699, 12.2191, 10.9208, 9.0209, 6.2158, 3.2466, 0.2169, 
-2.7807, -6.0439, -9.1262, -11.8684, -14.7779, -17.5825, -20.2452, 
-22.807, -25.3519, -27.6105, -29.7536, NA, NA, NA, NA), fan_line = c(1L, 
2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 
16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 
29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 
42L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 
14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 
27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 
40L, 41L, 42L)), class = "data.frame", row.names = c(NA, -84L
))
 

 data <- data %>% mutate(Group = rep(1:(n()/42), each = 42)) %>% dplyr::group_by(Group) %>% 
  mutate(start = min(which(!is.na(X))), end = max(which(!is.na(X))), midpoint = round((start end)/2, digits = 0)) %>% ungroup()

data$start_val_x <- 0
data$end_val_x <- 0
data$start_val_y <- 0
data$end_val_y <- 0


for (i in 1:nrow(data)){
  if (data[i, "fan_line"] == data[i, "start"]){
    data[i, "start_val_x"] = data[i, "X"]
    data[i, "start_val_y"] = data[i, "Y"]
  }
  else{data[i, "start_val_y"] = NA
  data[i, "start_val_x"] = NA}
}

for (i in 1:nrow(data)){
  if (data[i, "fan_line"] == data[i, "end"]){
    data[i, "end_val_x"] = data[i, "X"]
    data[i, "end_val_y"] = data[i, "Y"]
  }
  else{data[i, "end_val_y"] = NA
  data[i, "end_val_x"] = NA}
}

 

 data <- data %>%  group_by(Group) %>% fill(c(start_val_x, start_val_y), .direction = "down") %>% fill(c(start_val_x, start_val_y), .direction = "up")
data <- data %>%  group_by(Group) %>% fill(c(end_val_x, end_val_y), .direction = "down") %>% fill(c(end_val_x, end_val_y), .direction = "up")
 

 data <- data %>% group_by(Group) %>% mutate(theta = max(atan(diff(c(start_val_y, end_val_y))/diff(c(start_val_x, end_val_x))), na.rm = T))
 

 data <- data %>% group_by(Group) %>% bind_cols(as_tibble(rotate2(as.matrix(.)[,1:2], theta = min(.$theta))))
 

Мы могли бы использовать group_modify . Однако я не уверен, что приведенный ниже результат — это то, что вы ищете.

В обычном dplyr конвейере мы могли бы использовать cur_data() для доступа к данным каждой группы. Здесь это невозможно, потому что мы находимся внутри функции, отличной от dplyr. Для этого случая у нас есть group_map (который возвращает список) и group_modify (который возвращает сгруппированный tibble , если каждый вывод равен a data.frame ). Мы можем использовать лямбда-функцию, и вот .x наши сгруппированные данные.

 library(tidyverse)
library(lava)

data %>%
  group_by(Group) %>% 
  group_modify(~ as_tibble(rotate2(as.matrix(.x)[,1:2], theta = min(.x$theta))))

#> Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if `.name_repair` is omitted as of tibble 2.0.0.
#> Using compatibility `.name_repair`.

#> # A tibble: 84 x 3
#> # Groups:   Group [2]
#>    Group    V1    V2
#>    <int> <dbl> <dbl>
#>  1     1 NA    NA   
#>  2     1 NA    NA   
#>  3     1 NA    NA   
#>  4     1 NA    NA   
#>  5     1 NA    NA   
#>  6     1 NA    NA   
#>  7     1 NA    NA   
#>  8     1 NA    NA   
#>  9     1 NA    NA   
#> 10     1  8.26 -7.46
#> # … with 74 more rows
 

^{Создано 2021-04-13 пакетом reprex (версия 0.3.0)}