reshape to wide format, while varying only a single column at a time (for sensitivity analysis)

Question

There are already many Q&A's relating to reshaping data, but I did not find one that deals with this specific case.

I want to take a long format table that provides low, average and high values for an arbitrary number of parameters, with values varying over an arbitrary number of groups. Here is a simple example table with just two parameters (f1, f2) and two groups (A, B).

library(data.table)
input = fread("
grp variable value level
A   f1       0.1   low
A   f1       0.2   average
A   f1       0.3   high
A   f2       0.5   low
A   f2       0.6   average
A   f2       0.7   high
B   f1       1.0   low
B   f1       2.0   average
B   f1       3.0   high
B   f2       -10   low
B   f2       -5    average
B   f2       0     high
")

To conduct sensitivity analyses, I would like to convert this to a table in which each parameter is varied from low to high, while fixing all other parameters at their average value (for each group).

The expected output for the simple example would look like this:

expected = fread("
grp  variable    level  f1   f2
A    f1          low   0.1  0.6
A    f1          high  0.3  0.6
A    f2          low   0.2  0.5
A    f2          high  0.2  0.7
B    f1          low   1.0  -5
B    f1          high  3.0  -5
B    f2          low   2.0  -10
B    f2          high  2.0  0
")

I can find the varying factors for each sensitivity, using dcast:

dcast(input, grp + variable + level ~ variable)[level != 'average']
#    grp sensitivity level  f1    f2
# 1:   A          f1  high 0.3    NA
# 2:   A          f1   low 0.1    NA
# 3:   A          f2  high  NA   0.7
# 4:   A          f2   low  NA   0.5
# 5:   B          f1  high 3.0    NA
# 6:   B          f1   low 1.0    NA
# 7:   B          f2  high  NA   0.0
# 8:   B          f2   low  NA -10.0

But, I did not find a neat way to also fill in the average values for the other factors that works for any number of groups and factors. I'm really interested in base or data.table solutions, but other packages also welcome as they could help others.

Here's a slightly larger input table with 3 parameters and 3 groups, to test solutions on:

structure(list(grp = c("A", "A", "A", "A", "A", "A", "A", "A", 
"A", "B", "B", "B", "B", "B", "B", "B", "B", "B", "C", "C", "C", 
"C", "C", "C", "C", "C", "C"), variable = c("f1", "f1", "f1", 
"f2", "f2", "f2", "f3", "f3", "f3", "f1", "f1", "f1", "f2", "f2", 
"f2", "f3", "f3", "f3", "f1", "f1", "f1", "f2", "f2", "f2", "f3", 
"f3", "f3"), value = c(0.1, 0.2, 0.3, 0.5, 0.6, 0.7, 4, 5, 6, 
1, 2, 3, -10, -5, 0, 11, 12, 13, 100, 200, 300, 3, 6, 9, 21, 
22, 23), level = c("low", "average", "high", "low", "average", 
"high", "low", "average", "high", "low", "average", "high", "low", 
"average", "high", "low", "average", "high", "low", "average", 
"high", "low", "average", "high", "low", "average", "high")), row.names = c(NA, 
-27L), class = c("data.table", "data.frame"))

In case it helps, we can also generate larger input tables to test using the following. My current use case has nearly 10,000 groups and ~25 parameters.

Ngrp = 5
Nf = 7
grp = 1:Ngrp
f = paste0("f", 1:Nf)
input = expand.grid(grp = grp, variable=f, level = c("low", "average", "high"))
setDT(input)
setkey(input, grp, variable, level)
input[level == 'low',     value := rnorm(.N, grp,    grp/10), by=.(grp,variable)]
input[level == 'average', value := rnorm(.N, grp*5,  grp/2), by=.(grp,variable)]
input[level == 'high',    value := rnorm(.N, grp*10, grp), by=.(grp,variable)]

user_2884859 · Answer

I suggest a two step strategy. I was actually trying to do it in one syntax (i.e. without creating intermediate df1 but wasn't able to figure out how to use arguments when one lambda function is passed within another one in purrr style of writing functions). Nevertheless, since your final values are cross matching you indeed have to follow a longer route. This is only based on assumption that your sensitivity levels start from character f.

step-1 create intermediate df1

library(tidyverse)

merge(df %>% 
        select(v1 = variable) %>% 
        unique(), 
      df %>% 
        select(v2 = variable) %>% 
        unique(), 
      all.x = T) %>%
  full_join(df , by = c('v1' = 'variable')) %>%
  filter(level != 'average') %>%
  pivot_wider(id_cols = c(grp, v1, level),
              names_from = v2,
              values_from = value) -> df1

final step

library(glue)

df %>% filter(level == 'average') %>%
  mutate(variable = paste0('av_', variable)) %>%
  pivot_wider(id_cols = grp, names_from = variable, values_from = value) %>%
  right_join(df1, by = "grp") %>%
  mutate(across(starts_with("f"), ~ifelse(v1 != cur_column(),
                                          get(glue('av_{cur_column()}')),
                                          .)
                )
         ) %>%
  select(grp, variable = v1, level, starts_with("f")) 

# A tibble: 18 x 6
   grp   variable level    f1    f2    f3
           
 1 A     f1       low     0.1   0.6     5
 2 A     f1       high    0.3   0.6     5
 3 A     f2       low     0.2   0.5     5
 4 A     f2       high    0.2   0.7     5
 5 A     f3       low     0.2   0.6     4
 6 A     f3       high    0.2   0.6     6
 7 B     f1       low     1    -5      12
 8 B     f1       high    3    -5      12
 9 B     f2       low     2   -10      12
10 B     f2       high    2     0      12
11 B     f3       low     2    -5      11
12 B     f3       high    2    -5      13
13 C     f1       low   100     6      22
14 C     f1       high  300     6      22
15 C     f2       low   200     3      22
16 C     f2       high  200     9      22
17 C     f3       low   200     6      21
18 C     f3       high  200     6      23

The two steps are actually for better understanding. Two steps can be combined within one single pipe

df %>% filter(level == 'average') %>%
  mutate(variable = paste0('av_', variable)) %>%
  pivot_wider(id_cols = grp, names_from = variable, values_from = value) %>%
  right_join(merge(df %>% 
                     select(v1 = variable) %>% 
                     unique(), 
                   df %>% 
                     select(v2 = variable) %>% 
                     unique(), 
                   all.x = T) %>%
               full_join(df , by = c('v1' = 'variable')) %>%
               filter(level != 'average') %>%
               pivot_wider(id_cols = c(grp, v1, level),
                           names_from = v2,
                           values_from = value), by = "grp") %>%
  mutate(across(starts_with("f"), ~ifelse(v1 != cur_column(),
                                          get(glue('av_{cur_column()}')),
                                          .)
                )
         ) %>%
  select(grp, variable = v1, level, starts_with("f"))

user_8380272 · Answer

Using data.table we could also do:

f <- function(x, y)nafill(x, "const", na.omit(x[y=="average"]))

dcast(input, grp + variable + level ~ variable)[,
      rapply(.SD, f, "numeric", how="replace", y=level), by=grp][level !="average"]


   grp variable level  f1    f2
1:   A       f1  high 0.3   0.6
2:   A       f1   low 0.1   0.6
3:   A       f2  high 0.2   0.7
4:   A       f2   low 0.2   0.5
5:   B       f1  high 3.0  -5.0
6:   B       f1   low 1.0  -5.0
7:   B       f2  high 2.0   0.0
8:   B       f2   low 2.0 -10.0

user_2761575 · Answer

I found a data.table method using a row-wise loop:

out = dcast(input, grp + variable + level ~ variable)[level != 'average']
fs = input[, unique(variable)] # vector of unique parmeter names
f = function(g,v) input[grp==g & variable != v & level=="average", as.list(value)]
for (i in seq_len(nrow(out))) {
  set(out, i, setdiff(fs, out[i,variable]), out[i, f(grp, variable)]) 
}

reshape to wide format, while varying only a single column at a time (for sensitivity analysis)

3 Answers

step-1 create intermediate df1

final step