Using two data.frame for cumulative growth in R

user_2317315 0
Viewed 106

I give an example of what I want to achieve in the simplest possible way, I am stuck with it.

I have two data.frame, one with values and another one with percentages:

table <- structure(list(a = 1:10, b = 11:20, c = 21:30, type = c("g", 
"g", "g", "g", "g", "g", "g", "g", "g", "g")), row.names = c(NA, 
-10L), class = "data.frame")

growth <- structure(list(type = c("g", "g2"), a = c(1, 1), b = c(1.1, 1.3
), c = c(1.2, 1.1)), class = "data.frame", row.names = c(NA, 
-2L))

The first table named table looks like this:

    a  b  c type
1   1 11 21    g
2   2 12 22    g
3   3 13 23    g
4   4 14 24    g
5   5 15 25    g
6   6 16 26    g
7   7 17 27    g
8   8 18 28    g
9   9 19 29    g
10 10 20 30    g

and the second one named growth looks like this:

  type a   b   c
1    g 1 1.1 1.2
2   g2 1 1.3 1.1

What I would like to achieve is for example in the first line on the table object:

the type column gives me the growth g from the table growth, then:

a = 1 * 1, b = (1*1)*1.1 + 11, c = ((1*1)*1.1 + 11)*1.2 + 21

and this for each line of the data frame.

Edit: There are many good answers worth checking out. The marked solution is because it is more readable and flexible.

r
4 Answers

To show that it works on n number of cols. Let's assume out initial data be like

> table
    a  b  c  d  e type
1   1 11 21 31 41    g
2   2 12 22 32 42    g
3   3 13 23 33 43    g
4   4 14 24 34 44    g
5   5 15 25 35 45    g
6   6 16 26 36 46    g
7   7 17 27 37 47    g
8   8 18 28 38 48    g
9   9 19 29 39 49    g
10 10 20 30 40 50    g

> growth
  type a   b   c   d    e
1    g 1 1.1 1.2 1.3 1.25
2   g2 1 1.3 1.1 1.2 1.15

#then
table %>% 
  mutate(id = row_number()) %>% 
  pivot_longer(-c(id, type), values_to = "Val1") %>%
  left_join(growth %>% 
              pivot_longer(-type, values_to = "Val2"), 
            by = c("type", "name")) %>% 
  group_split(id) %>%
  map_df(~accumulate2(.x$Val1, 
                      .x$Val2, 
                      .init = 0, 
                      ~(..1 * ..3) + ..2 )[-1] %>% 
           set_names(paste0("x", seq_len(nrow(.x))))) %>%
  bind_cols(table, .)

    a  b  c  d  e type x1   x2    x3      x4     x5
1   1 11 21 31 41    g  1 12.1 35.52  77.176 137.47
2   2 12 22 32 42    g  2 14.2 39.04  82.752 145.44
3   3 13 23 33 43    g  3 16.3 42.56  88.328 153.41
4   4 14 24 34 44    g  4 18.4 46.08  93.904 161.38
5   5 15 25 35 45    g  5 20.5 49.60  99.480 169.35
6   6 16 26 36 46    g  6 22.6 53.12 105.056 177.32
7   7 17 27 37 47    g  7 24.7 56.64 110.632 185.29
8   8 18 28 38 48    g  8 26.8 60.16 116.208 193.26
9   9 19 29 39 49    g  9 28.9 63.68 121.784 201.23
10 10 20 30 40 50    g 10 31.0 67.20 127.360 209.20

Earlier Answer This one is not hardcoded and based on tidyverse style of syntax in a single pipe. I have assumed your new columns to be named as x, y, & z. I would be happier if someone is able to shorten it.

table %>% 
  mutate(id = row_number()) %>% 
  pivot_longer(-c(id, type), values_to = "Val1") %>%
  left_join(growth %>% 
              pivot_longer(-type, values_to = "Val2"), 
            by = c("type", "name")) %>% 
  group_split(id) %>%
  map_df(~accumulate2(.x$Val1, 
                      .x$Val2, 
                      .init = 0, 
                      ~(..1 * ..3) + ..2 )[-1] %>% 
           set_names(paste0("x", seq_len(nrow(.x))))) %>%
  bind_cols(table, .)

    a  b  c type  x1  x2    x3
1   1 11 21    g  1 12.1 35.52
2   2 12 22    g  2 14.2 39.04
3   3 13 23    g  3 16.3 42.56
4   4 14 24    g  4 18.4 46.08
5   5 15 25    g  5 20.5 49.60
6   6 16 26    g  6 22.6 53.12
7   7 17 27    g  7 24.7 56.64
8   8 18 28    g  8 26.8 60.16
9   9 19 29    g  9 28.9 63.68
10 10 20 30    g 10 31.0 67.20

I have indented the above syntax properly so as to understand it easily.

  • Both data have been pivot longer and joined to get both values as Val1 and Val2 respectively.
  • Each of the a/b/c row has since now been in a single column, I split each one into a separate list.
  • To carry out same operation on each item of this list, I used map function. Since we may need the final output nicely structured in a dataframe way, I used two more things here
    • used map_df instead
    • set the names of each output as x1/x2/x3 (requirement of map_df)
  • Now to carry out operation iteratively on Val1 and val2, I used accumulate2 so that expected operation may be carried out.

All done.

Note this syntax will work for n number of variables and not just three. Only thing to be taken care of is names, which can also be softcoded if you want.

user_28848590

Something like this?

df=merge(table,growth,by="type")

data.frame(
  "a"=(df$a.x*df$a.y),
  "b"=(df$a.x*df$a.y*df$b.y+df$b.x),
  "c"=(df$a.x*df$a.y*df$b.y+df$b.x)*df$c.y+df$c.x
)

    a    b     c
1   1 12.1 35.52
2   2 14.2 39.04
3   3 16.3 42.56
4   4 18.4 46.08
5   5 20.5 49.60
6   6 22.6 53.12
7   7 24.7 56.64
8   8 26.8 60.16
9   9 28.9 63.68
10 10 31.0 67.20

A more general approach below, results in columns ending with .y for no particular reason.

df=merge(table,growth,by="type")

cls=colnames(df)[grepl("\\.y",colnames(df))]

for (i in 1:length(cls)) {
  if (i==1) {
    df[cls[i]]=df[gsub("\\.y","\\.x",cls[i])]*df[cls[i]]
  } else {
    df[cls[i]]=df[cls[i-1]]*df[cls[i]]+df[gsub("\\.y","\\.x",cls[i])]
  }
}

   type a.x b.x c.x a.y  b.y   c.y
1     g   1  11  21   1 12.1 35.52
2     g   2  12  22   2 14.2 39.04
3     g   3  13  23   3 16.3 42.56
4     g   4  14  24   4 18.4 46.08
5     g   5  15  25   5 20.5 49.60
6     g   6  16  26   6 22.6 53.12
7     g   7  17  27   7 24.7 56.64
8     g   8  18  28   8 26.8 60.16
9     g   9  19  29   9 28.9 63.68
10    g  10  20  30  10 31.0 67.20
user_29749510 
library(tidyverse)

f <- function(value, growth_factor){
  
  res <- vector("double", length(value))
  res[1] <- value[1] * growth_factor[1]
  
  value <- tail(value, -1)
  growth_factor <- tail(growth_factor, -1)
  
  for(i in seq_along(value)){
    res[i + 1] <- res[i] * growth_factor[i] + value[i]
  }
  
  res
}

table <- table %>%
  mutate(id = row_number()) %>%
  pivot_longer(cols = -c(type, id))

growth <- growth %>%
  pivot_longer(cols = -type, values_to = "growth_factor")

left_join(table, growth, by = c("type", "name")) %>%
  group_by(id) %>%
  summarise(name = name, calculated_value = f(value, growth_factor)) %>%
  ungroup() %>%
  pivot_wider(names_from = name, values_from = calculated_value) %>%
  select(-id)
user_121484020

Here is just another solution that I thought might be of interest to you:

library(dplyr)
library(tidyr)
library(stringr)
library(purrr)


growth %>% 
  rename_with(~ str_to_upper(.x), a:c) %>% 
  right_join(table, by = "type") %>%
  relocate(a, b, c, type) %>%
  mutate(pmap(list(a, b, c, A, B, C), function(a, b, c, A, B, C) {
    a1 <- A * a
    b1 <- a1 * B + b
    c1 <- b1 * C + c
    cbind(a1, b1, c1) %>%
      set_names(c("a1", "b2", "c1"))
  })) %>% 
  unnest_wider(8) %>%
  select(-c(A, B, C))


# A tibble: 10 x 7
       a     b     c type     a1    b2    c1
   <int> <int> <int> <chr> <dbl> <dbl> <dbl>
 1     1    11    21 g         1  12.1  35.5
 2     2    12    22 g         2  14.2  39.0
 3     3    13    23 g         3  16.3  42.6
 4     4    14    24 g         4  18.4  46.1
 5     5    15    25 g         5  20.5  49.6
 6     6    16    26 g         6  22.6  53.1
 7     7    17    27 g         7  24.7  56.6
 8     8    18    28 g         8  26.8  60.2
 9     9    19    29 g         9  28.9  63.7
10    10    20    30 g        10  31    67.2
user_143145200
Related