Есть ли способ перебрать имена столбцов с помощью mutate? - PullRequest
0 голосов
/ 10 июня 2019

У меня есть фрейм данных, который описывает 25 точек в плоскости x-y для одного человека. Для 3 человек, который выглядит как:

input_data

   id  x1  y1  x2  y2  x3  y3 ... x25  y25  
   1   9   3   4   7   1   3  ... 2    8     
   2   2   5   3   3   1   7  ... 9    6
   3   5   4   1   8   9   4  ... 2    7

Я хочу вычислить некоторое сложное число, называемое TMI, которое определяется для каждого сравнения между парами x-y. Например, для точек (x1, y1) и (x2, y2) TMI:

input_data <- input_data %>% 
    mutate(
      A = (x1/x2) + (y1/y2),
      TMI_1_2 = case_when(
      x1 == x2 & y1 == y2 ~ (1-sqrt(pmin((x1*y2)/(x2*y1),(x1*y2)/(x2*y1)))),
      x2/x1 + y2/y1 >= 1 & A == 1 ~ 0,
      TRUE ~ 1)
  )

Теперь мне нужно вычислить это число для всех возможных пар из 25 комбинаций x-y (это 300 пар). Следующее проясняет это:

list_points <- seq.int(25)
table_comparisons <- combn(list_points, 2)

Каков оптимальный способ зацикливания имен столбцов с помощью mutate, чтобы я мог вычислить 300 различных TMI, которые мне нужны?

Я думаю, что что-то вроде следующего будет работать, но это не так:

for(i in 1:300) { 
  point1 <- table_comparisons[1,i]
  point2 <- table_comparisons[2,i]

input_data <- input_data %>% 
    mutate(
      A = (xpoint1/xpoint2) + (ypoint1/ypoint2),
      TMI_point1_point2 = case_when(
      xpoint1 == xpoint2 & ypoint1 == ypoint2 ~ (1-sqrt(pmin((xpoint1*ypoint2)/(xpoint2*ypoint1),(xpoint1*ypoint2)/(xpoint2*ypoint1)))),
      xpoint2/xpoint1 + ypoint2/ypoint1 >= 1 & A == 1 ~ 0,
      TRUE ~ 1)
  )
}

Есть идеи?

Спасибо за ваше время!

1 Ответ

0 голосов
/ 10 июня 2019

Возможно, вам лучше преобразовать ваши данные в пары x, y, прежде чем применять формулу.Попробуйте это:

library(tidyverse)

input_data <- tibble(ID = seq(1:5),
                     x1 = runif(5),
                     y1 = runif(5),
                     x2 = runif(5),
                     y2 = runif(5)
                     )

input_data_long <- input_data %>% 
  gather(key, value, -ID) %>% 
  mutate(key1 = stringr::str_extract(key, "[a-zA-Z]"),
         key2 = stringr::str_extract(key, "\\d+")) %>% 
  select(-key) %>% 
  spread(key1, value)

Теперь вы можете изменить новый столбец из x & y, а затем развернуть таблицу обратно в любой формат, который вам нужен.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...