Column-wise computation-CodePudding

I am trying to make columnwise calculations. The goal is to compute an index (IX) for for every player (r001,r002,r003), over every gameround (row).

#the data frame looks like this: 
df <- data.frame(gameround= c("1_1", "1_2", "1_3"),
  r001 = c(3,5,4), r002 = c(2,3,5), r003 = c(1,2,2), weight001=c(0.7,0.8,0.7), 
                 weight002 = c(0.6,0.1,0.6), weight003=c(0.2,0.7,0.2), 
                 FORMULA = c("PosdownNegUp", "NegdownPosUp", "PosdownNegUp"), 
                IXsum = NA)

#There are two different formulas:
#FORMULA PosdownNegUp:
#if r001 is 1, take weight001*1. 
#if r001 is 2, take  weight001*0.5. 
#if r001 is 4, take weight001*-0.5. 
#if r001 is 5, take weight001*-1. 
#IXSUM = repeat for every r00 and take the sum per gameround. 

#FORMULA NegdownPosUp: 
#if r001 is 1, take weight001*-1. 
#If r001 is 2, take weight001*-0.5.
#if r001 is 4, take weight001*0.5. 
#if r001 is 5, take weight001*1. 
#IXSUM = repeat for every r00 and take the sum per gameround. 

#Player scores of 3 or 0 should not be included in the IXsum calculation.

#the result should look like this: 
df

#  gameround r001 r002 r003  weight001  weight002 weight003     FORMULA      IXsum
#       1_1    3    2    1       0.7       0.6       0.2     PosdownNegUp     0.5  # = (0.6*0.5) (0.2*1)
#       1_2    5    3    2       0.8       0.1       0.7     NegdownPosUp     0.45 # (0.8*1) (0.7*-0.5)
#       1_3    4    5    2       0.7       0.6       0.2     PosdownNegUp    -0.85 # = (0.7*-0.5) (0.6*-1) (0.2*0.5)

I'd be extremely grateful if anyone could help me out!

CodePudding user response：

looks like a job for dplyr::case_when() in combination with some rlang stuff

for(i in  1:3){

  # define symbols for the variables
  variable <- paste0("r00", i)
  variable <- rlang::sym(variable)

  tempvariable <- paste0("IXsum", i)
  tempvariable <- rlang::sym(tempvariable)

  formulavariable <- paste0("weight00", i)
  formulavariable <- rlang::sym(formulavariable)


df <- df %>% dplyr::mutate(
  # notice that we use the 'bang bang' operator (!!) to tell R that we use symbols, and use ':=' to assign to a variable instead of just '='
  !!tempvariable := dplyr::case_when(
    FORMULA == "PosdownNegUp" & !!variable == 1 ~ !!formulavariable,
    FORMULA == "PosdownNegUp" & !!variable == 2 ~ !!formulavariable*0.5,
    FORMULA == "PosdownNegUp" & !!variable == 4 ~ !!formulavariable*-0.5,
    FORMULA == "PosdownNegUp" & !!variable == 5 ~ !!formulavariable*-1,
    FORMULA == "NegdownPosUp" & !!variable == 1 ~ !!formulavariable*-1,
    FORMULA == "NegdownPosUp" & !!variable == 2 ~ !!formulavariable*-0.5,
    FORMULA == "NegdownPosUp" & !!variable == 4 ~ !!formulavariable*0.5,
    FORMULA == "NegdownPosUp" & !!variable == 5 ~ !!formulavariable*1))

}

This results in:

df

  > gameround  r001  r002  r003 weight001 weight002 weight003 FORMULA IXsum IXsum1 IXsum2 IXsum3
  <chr>     <dbl> <dbl> <dbl>     <dbl>     <dbl>     <dbl> <chr>        <lgl>  <dbl>  <dbl>  <dbl>
1 1_1           3     2     1       0.7       0.6       0.2 PosdownNegUp NA     NA       0.3   0.2 
2 1_2           5     3     2       0.8       0.1       0.7 NegdownPosUp NA      0.8    NA    -0.35
3 1_3           4     5     2       0.7       0.6       0.2 PosdownNegUp NA     -0.35   -0.6   0.1

In the end, you can sum up the temporary columns

df %>% dplyr::mutate(
  IXsum = ifelse(is.na(IXsum1), 0,IXsum1) ifelse(is.na(IXsum2), 
0,IXsum2) ifelse(is.na(IXsum3), 0,IXsum3))
%>% 
dplyr::select(-IXsum1, -IXsum2, -IXsum3)


gameround  r001  r002  r003 weight001 weight002 weight003 FORMULA      IXsum
  <chr>     <dbl> <dbl> <dbl>     <dbl>     <dbl>     <dbl> <chr>        <dbl>
1 1_1           3     2     1       0.7       0.6       0.2 PosdownNegUp  0.5 
2 1_2           5     3     2       0.8       0.1       0.7 NegdownPosUp  0.45
3 1_3           4     5     2       0.7       0.6       0.2 PosdownNegUp -0.85

CodePudding user response：

Convert the data from wide-to-long, then compute per group - gameround. This would scale to any number of players:

library(data.table)

#convert to data.table
setDT(df)

# wide-to-long, then compute
melt(df, id.vars = c("gameround", "FORMULA", "IXsum"), 
          measure.vars = patterns("^r", "^weight"), 
          value.name = c("rr", "ww") 
     )[,.(IXsum = sum(ww * 
                        ifelse(FORMULA == "PosdownNegUp", -1,
                               ifelse(FORMULA == "NegdownPosUp", 1)) *
                        ifelse(rr %% 2 == 0, 0.5, 1))), by = "gameround"]
     
#    gameround IXsum
# 1:       1_1 -1.20
# 2:       1_2  1.25
# 3:       1_3 -1.05