Как преобразовать несколько столбцов в новые несколько столбцов с помощью dplyr

Question

Я пытаюсь преобразовать 3 столбца в 3 новых столбца в большой таблице (с большим количеством столбцов). 3 новых столбца зависят от первых существующих 3 столбцов. 4-й новый столбец зависит только от 4-го существующего столбца. По сути, я хочу повернуть координаты точек (в столбцах x, y, z) в трехмерном пространстве и сохранить их в новых столбцах (x_rot, y_rot, z_rot).

Я могу преобразовать 3 столбца в 1 новый столбец и повторите это для каждого измерения, которое кажется расточительным. Было бы проще, если бы моя пользовательская функция получала 3 координаты и возвращала 3 повернутые координаты.

Здесь, если я делаю это с помощью для l oop:

df = data.frame(x = rnorm(5), y = rnorm(5), z = rnorm(5))
for(i in nrow(df){
    r = sqrt(df$x[i] ^ 2 + df$y[i] ^ 2 + df$z[i] ^ 2)
    phi = atan2(y = df$y[i], x = df$x[i])
    phi = phi + rotationAngle1
    theta = acos(df$z[i] / r)
    theta = theta + rotationAngle2
    df$x_ROT[i] = r * cos(phi) * sin(theta)
    df$y_ROT[i] = r * sin(phi) * sin(theta)
    df$z_ROT[i] = r * cos(theta)
}

или с помощью mutate_at и функция rotate :

rotate = function(x,y,z){
    r = sqrt(x ^ 2 + y ^ 2 + z ^ 2)
    phi = atan2(y = y, x = x)
    phi = phi + rotationAngle1
    theta = acos(z / r)
    theta = theta + rotationAngle2
    return(c(r * cos(phi) * sin(theta), r * sin(phi) * sin(theta),r * cos(theta))
    # OR
    return(list(x = r * cos(phi) * sin(theta), y = r * sin(phi) * sin(theta), z = r * cos(theta))
}

Как я могу сделать это с помощью dplyr? Как я могу сформулировать df%>% group_by (group)%>% mutate_at (???)

Answer 1

С dplyr мы можем использовать mutate_at, где f1, f2 - функции, используемые для вращения

library(dplyr)
df2 <- df1 %>%
         mutate_at(vars(x, y, z),   list(rot =  f1)) %>%
         mutate(col4_rot = f2(col4))

---

В версии devel используйте mutate с across

df2 <- df1 %>%
           mutate(across(vars(x, y, z),  f1, names = "{col}_rot"), 
                   col4_rot = f2(col4))

Обновление

На основе обновленной функции мы можем использовать pmap

library(purrr)
library(stringr)

pmap_dfr(df, rotate) %>% 
     rename_all(~ str_c(., '_rot')) %>% 
     bind_cols(df, .)
# A tibble: 5 x 6
#        x       y      z   x_rot    y_rot   z_rot
#    <dbl>   <dbl>  <dbl>   <dbl>    <dbl>   <dbl>
#1 -0.303   1.20   -0.503 -0.0457  0.00799 -1.34  
#2 -0.0662 -0.599   1.45   1.35   -0.793    0.0405
#3  0.239   0.953   1.49  -1.39    1.09    -0.288 
#4 -0.490   0.0106 -0.622  0.157   0.333   -0.701 
#5  0.554   1.08    0.761 -0.748   0.928   -0.802 

, где

rotationAngle2 <- 20
rotate <- function(x,y,z){
     r = sqrt(x ^ 2 + y ^ 2 + z ^ 2)
     phi = atan2(y = y, x = x)
     phi = phi + rotationAngle2
     theta = acos(z / r)
     theta = theta + rotationAngle2   
     return(list(x = r * cos(phi) * sin(theta), 
                 y = r * sin(phi) * sin(theta),
                 z = r * cos(theta)))
 }

---

Это также возможно с mutate

library(tidyr)
df %>%
  rowwise %>% 
  mutate(out = list(rotate(x, y, z))) %>% 
  unnest_wider(c(out))
# A tibble: 5 x 6
#        x       y      z   x_rot    y_rot   z_rot
#    <dbl>   <dbl>  <dbl>   <dbl>    <dbl>   <dbl>
#1 -0.303   1.20   -0.503 -0.0457  0.00799 -1.34  
#2 -0.0662 -0.599   1.45   1.35   -0.793    0.0405
#3  0.239   0.953   1.49  -1.39    1.09    -0.288 
#4 -0.490   0.0106 -0.622  0.157   0.333   -0.701 
#5  0.554   1.08    0.761 -0.748   0.928   -0.802 

Или другой вариант - вернуть list в summarise, а затем выполнить unnest_wider и unnest

df %>%
    summarise(out = list(rotate(x, y, z))) %>% 
    unnest_wider(c(out)) %>% 
    unnest(cols = everything()) %>%
    bind_cols(df, .)
# A tibble: 5 x 6
#        x       y      z   x_rot    y_rot   z_rot
#    <dbl>   <dbl>  <dbl>   <dbl>    <dbl>   <dbl>
#1 -0.303   1.20   -0.503 -0.0457  0.00799 -1.34  
#2 -0.0662 -0.599   1.45   1.35   -0.793    0.0405
#3  0.239   0.953   1.49  -1.39    1.09    -0.288 
#4 -0.490   0.0106 -0.622  0.157   0.333   -0.701 
#5  0.554   1.08    0.761 -0.748   0.928   -0.802 

, где

rotate <- function(x,y,z){
     r = sqrt(x ^ 2 + y ^ 2 + z ^ 2)
     phi = atan2(y = y, x = x)
     phi = phi + rotationAngle2
     theta = acos(z / r)
     theta = theta + rotationAngle2   
     return(list(x_rot = r * cos(phi) * sin(theta), 
                 y_rot = r * sin(phi) * sin(theta), 
                 z_rot = r * cos(theta)))
 }