реструктуризация фрейма данных ковариаций от длинного до широкого

Question

Фрейм данных have содержит три переменные:

1. from - символ - название меры
2. to - символ - имя другой меры
3. covariance - число - ковариация между двумя мерами

Вот ссылка на данные .Ниже приведен результат head(have):

from                   to                     covariance
a_airportscreener      a_airportscreener     4.419285714
a_airportscreener      e_airportscreener    -1.328928571
a_airportscreener      g_airportscreener    -3.038928571
a_airportscreener      p_airportscreener    0.3292857143
a_airportscreener   pres_airportscreener    0.6452857143
a_automechanic            a_automechanic     2.635535714
a_automechanic            e_automechanic   -0.3439285714

Я хочу создать фрейм данных с именем need, который будет записывать ковариации между префиксными версиями одного и того же названия должности в отдельных столбцах.Например, первая строка будет выглядеть следующим образом:

job                a_a       a_e       a_g       a_p       a_pres       e_a       e_e       e_g      e_p      e_pres      g_a      g_e      g_g      g_p      g_pres      p_a      p_e      p_g      p_p      p_pres      pres_a      pres_e      pres_g      pres_p      pres_pres
airportscreener  4.419    -1.329    -3.039     0.329        0.645    -1.329     2.333     2.441   -1.015       0.659   -3.039    2.441   14.253    3.070       0.977    0.329   -1.015    3.070    6.505       0.366       0.645       0.659       0.977       0.366          0.697

(я округлил значения в have, чтобы сохранить пример need на странице, но это не является частью вопроса.)

Answer 1

Это не так элегантно, как ответ @Ronak Shah, но я работал над чем-то похожим и подумал, что, возможно, стоит поделиться с кем-то там.Он также использует pivot_longer и pivot_wider в последних tidyr.

library(readxl)
library(tidyr)
library(dplyr)

df <- read_excel("cov_data.xlsx")

need <- df %>%
  separate(from, into = c('from1', 'job'), sep = '_') %>%
  separate(to, into = 'to1', extra = 'drop', sep = '_') %>%
  unite(comb1, from1, to1, remove = F) %>%
  unite(comb2, to1, from1, remove = T) %>%
  pivot_longer(c(comb1, comb2)) %>%
  dplyr::select(-name) %>%
  distinct() %>%
  pivot_wider(names_from = value, values_from = covariance) %>%
  dplyr::select(job, order(colnames(.)))

# A tibble: 58 x 26
   job     a_a      a_e    a_g     a_p  a_pres      e_a   e_e    e_g    e_p  e_pres    g_a    g_e   g_g    g_p g_pres     p_a    p_e    p_g
   <chr> <dbl>    <dbl>  <dbl>   <dbl>   <dbl>    <dbl> <dbl>  <dbl>  <dbl>   <dbl>  <dbl>  <dbl> <dbl>  <dbl>  <dbl>   <dbl>  <dbl>  <dbl>
 1 airp…  4.42 -1.33     -3.04  0.329   0.645  -1.33    2.33   2.44  -1.02   0.659   -3.04  2.44   14.3   3.07  0.977  0.329  -1.02    3.07
 2 auto…  2.64 -0.344     6.26 -0.712  -0.595  -0.344   0.499  0.113  0.891  0.321    6.26  0.113 203.    5.16  0.645 -0.712   0.891   5.16
 3 auto…  2.67 -0.466     2.36 -0.106  -0.878  -0.466   0.72  -5.95   0.431  0.194    2.36 -5.95  252.    4.65 -4.64  -0.106   0.431   4.65
 4 blkj…  2.50  0.529    -6.79  0.0129 -0.0666  0.529   1.56  -8.58  -0.703  0.384   -6.79 -8.58  247.    2.11  1.68   0.0129 -0.703   2.11
 5 blkt…  1.04 -0.00143   4.86  0.993  -0.194  -0.00143 0.229 -1.69   0.276 -0.0351   4.86 -1.69  260.   14.3   2.44   0.993   0.276  14.3 
 6 brid…  4.15  2.05    -11.5  -1.21    0.453   2.05    2.05  -9.09  -0.342  0.576  -11.5  -9.09  326.   -2.07  0.992 -1.21   -0.342  -2.07
 7 cart…  1.79  0.458    -4.22  0.451  -0.410   0.458   1.23   3.54   0.43  -0.0674  -4.22  3.54  478.   10.5  -1.21   0.451   0.43   10.5 
 8 chem…  2.29  0.479    12.4  -0.0384 -0.164   0.479   0.811  2.15   0.784  0.0469  12.4   2.15  238.    2.58 -2.05  -0.0384  0.784   2.58
 9 clth…  4.10  1.15    -18.9   1.77    0.728   1.15    1.7   -4.00   1.65   0.133  -18.9  -4.00  193.  -17.1  -6.81   1.77    1.65  -17.1 
10 coag…  2.23 -0.382    -7.79 -0.0190  0.460  -0.382   0.342  4.11   0.161  0.0398  -7.79  4.11  444.    1.96 -7.55  -0.0190  0.161   1.96

Answer 2

Попробуйте этот подход на ваших полных данных

library(tidyverse)

cov_mat %>%
  rownames_to_column() %>% 
  pivot_longer(cols =-rowname) %>%
  mutate(key = paste0(sub("_.*", "\\1", name), "_", sub("_.*", "\\1", rowname)),
         rowname = sub(".*_(.*)_.*", "\\1", rowname), 
         name = sub(".*_(.*)_.*", "\\1", name)) %>%
  filter(rowname == name) %>%
  select(-rowname) %>%
  pivot_wider(names_from = key, values_from = value) 


# A tibble: 58 x 26
#   name   a_a      e_a    g_a     p_a  pres_a      a_e   e_e    g_e .....
#   <chr> <dbl>    <dbl>  <dbl>   <dbl>   <dbl>    <dbl> <dbl>  <dbl>
# 1 airp…  4.42 -1.33     -3.04  0.329   0.645  -1.33    2.33   2.44 
# 2 auto…  2.64 -0.344     6.26 -0.712  -0.595  -0.344   0.499  0.113
# 3 auto…  2.67 -0.466     2.36 -0.106  -0.878  -0.466   0.72  -5.95 
# 4 blkj…  2.50  0.529    -6.79  0.0129 -0.0666  0.529   1.56  -8.58 
# 5 blkt…  1.04 -0.00143   4.86  0.993  -0.194  -0.00143 0.229 -1.69 
# 6 brid…  4.15  2.05    -11.5  -1.21    0.453   2.05    2.05  -9.09 
# 7 cart…  1.79  0.458    -4.22  0.451  -0.410   0.458   1.23   3.54 
# 8 chem…  2.29  0.479    12.4  -0.0384 -0.164   0.479   0.811  2.15 
# 9 clth…  4.10  1.15    -18.9   1.77    0.728   1.15    1.7   -4.00 
#10 coag…  2.23 -0.382    -7.79 -0.0190  0.460  -0.382   0.342  4.11