Is there a way to modify specific cells in a data.frame with an apply-statement?-CodePudding

I have a data set

   V1  V2  V3  V4
1 0.2 0.1 0.0 0.8
2 0.3 0.4 0.3 0.0
3 0.1 0.3 0.2 0.0
4 0.2 0.1 0.4 0.1
5 0.2 0.1 0.1 0.1

in which each variable has one cell to which I would like to add a fraction (10 %) of the other values in the same column.

This indicates the row in each variable that should receive the bonus:

bonus<-c(2,3,1,4)

And the desired output is this:

   V1   V2   V3   V4
1 0.18 0.09 0.10 0.72
2 0.37 0.36 0.27 0.00
3 0.09 0.37 0.18 0.00
4 0.18 0.09 0.36 0.19
5 0.18 0.09 0.09 0.09

I do this with a for-loop:

for(i in 1:ncol(tab)){
  tab[bonus[i],i]<-tab[bonus[i],i] sum(0.1*tab[-bonus[i],i])
  tab[-bonus[i],i]<-tab[-bonus[i],i]-(0.1*tab[-bonus[i],i])
}

First row in the {} adds the 0.1*sum_of_other_values to the desired cell whose index is in bonus, second row subtracts from all cells but the one in bonus.

But I need to do this with a lot of columns in a lot of matrices and am struggling with including the information from the external vector bonus into a loop-less function.

Is there a way to vectorise this and then apply it across the datasets to make it faster?

Thanks very much!

( Example data:

tab<-data.frame(V1=c(0.2,0.3,0.1,0.2,0.2),
                V2=c(0.1,0.4,0.3,0.1,0.1),
                V3=c(0.00,0.3,0.2,0.4,0.1),
                V4=c(0.8,0.0,0.0,0.1,0.1))

)

CodePudding user response：

Try this:

mapply(
  function(vec, bon) { 
    more <- vec/10
    vec   ifelse(seq_along(vec) %in% bon, sum(more[-bon]), -more)
  }, asplit(tab, 2), bonus)
#        V1   V2   V3   V4
# [1,] 0.18 0.09 0.10 0.72
# [2,] 0.37 0.36 0.27 0.00
# [3,] 0.09 0.37 0.18 0.00
# [4,] 0.18 0.09 0.36 0.19
# [5,] 0.18 0.09 0.09 0.09

Sometimes I try to separate the change out of the function (such as when you want to troubleshoot the magnitude of change or some other summary statistic about it before updating the original table); if that appeals, then this can be shifted slightly:

changes <- mapply(
  function(vec, bon) {
    more <- vec/10
    ifelse(seq_along(vec) %in% bon, sum(more[-bon]), -more)
  }, asplit(tab, 2), bonus)
changes
#         V1    V2    V3    V4
# [1,] -0.02 -0.01  0.10 -0.08
# [2,]  0.07 -0.04 -0.03  0.00
# [3,] -0.01  0.07 -0.02  0.00
# [4,] -0.02 -0.01 -0.04  0.09
# [5,] -0.02 -0.01 -0.01 -0.01
tab   changes
#     V1   V2   V3   V4
# 1 0.18 0.09 0.10 0.72
# 2 0.37 0.36 0.27 0.00
# 3 0.09 0.37 0.18 0.00
# 4 0.18 0.09 0.36 0.19
# 5 0.18 0.09 0.09 0.09