CODEWITHSUNDEEP
r
Mark Miller
Mark Miller

Reputation: 13123

weighted averages of paired observations in R

Yesterday I posted a question asking how to obtain averages of observations in neighboring columns of a data set:

average pairs of columns in R

Today I realized I actually need weighted averages. I tried modifying the answer above to the revised situation, but still do not understand the family of apply functions well enough to do so easily.

I have written code to obtain weighted averages for an example data set below and can probably use that code with my real data. Nevertheless, if someone is able to illustrate how to use the apply family of functions here for weighted averages, that will go a long way, I think, toward improving my understanding and coding proficiency. Regardless, thank you for all past and future help and ideas.

x = read.table(text = "
  site     yr1  yr2  yr3  yr4
    1      10   15    6    8
    2      10   20   30   40
    3       5   NA    2    3
    4     100  100   NA   NA", 
sep = "", header = TRUE)

x

weights = read.table(text = "
  site    yr1  yr2  yr3  yr4
    1       2    4    1    3
    2       2    2    4    2
    3       3    2    2    3
    4       4    2    2    4", 
sep = "", header = TRUE)

weights

x.weights = x * weights

numerator <- matrix(NA, ncol=((ncol(x.weights)/2)+1), nrow=nrow(x.weights))

for(i in 1: ((ncol(weights)-1)/2)) {
  for(j in 1:   nrow(weights)      ) {

    numerator[j,   1 ] <- x[j,1]
    numerator[j,(i+1)] <- sum(c(x.weights[j,(1 + ((i-1)*2 + 1))], x.weights[j,(1 + ((i-1)*2 + 2))]), na.rm = TRUE) 

  }
}

numerator

denominator <- matrix(NA, ncol=((ncol(weights)/2)+1), nrow=nrow(weights))

for(i in 1: ((ncol(weights)-1)/2)) {
  for(j in 1:   nrow(weights)      ) {

    denominator[j,   1 ] <- x[j,1]
    denominator[j,(i+1)] <- sum(c(weights[j,(1 + ((i-1)*2 + 1))], weights[j,(1 + ((i-1)*2 + 2))]), na.rm = TRUE) 

  }
}

denominator

weighted.ave <- numerator[,2:ncol(numerator)] / denominator[,2:ncol(denominator)]
weighted.ave

# insert value from x if one of a pair is missing
# insert NA if both in a pair are missing

adj.weighted.ave <- weighted.ave

for(i in 1: ((ncol(x)-1)/2)) {
  for(j in 1:   nrow(x)      ) {

    if( is.na(x[j,(1 + (i-1)*2 + 1)]) & !is.na(x[j,(1 + (i-1)*2 + 2)])) adj.weighted.ave[j,i] =  sum(c(x[j,(1 + ((i-1)*2 + 1))], x[j,(1 + ((i-1)*2 + 2))]), na.rm = TRUE) 
    if(!is.na(x[j,(1 + (i-1)*2 + 1)]) &  is.na(x[j,(1 + (i-1)*2 + 2)])) adj.weighted.ave[j,i] =  sum(c(x[j,(1 + ((i-1)*2 + 1))], x[j,(1 + ((i-1)*2 + 2))]), na.rm = TRUE) 
    if( is.na(x[j,(1 + (i-1)*2 + 1)]) &  is.na(x[j,(1 + (i-1)*2 + 2)])) adj.weighted.ave[j,i] =  NA 

 }
}

adj.weighted.ave

#           [,1]     [,2]
# [1,]  13.33333  7.50000
# [2,]  15.00000 33.33333
# [3,]   5.00000  2.60000
# [4,] 100.00000       NA

Upvotes: 1

Views: 196

Answers (2)

nassimhddd
nassimhddd

Reputation: 8510

Using the elements from the answer to your previous question:

numerator <- sapply(seq(2,ncol(x.weights),2), function(i) {
  apply(x.weights[,c(i, i+1)], 1, sum, na.rm=T)
})

denominator <- sapply(seq(2,ncol(weights),2), function(i) {
  apply(weights[,c(i, i+1)], 1, sum, na.rm=T)
})

numerator/denominator

Upvotes: 1

IRTFM
IRTFM

Reputation: 263421

 apply(x, 1, function(rw) weighted.mean( rw[2:5], 
                     weights=weights[rw["site"], 2:5 ] ,na.rm=TRUE) )
[1]   9.750000  25.000000   3.333333 100.000000

This does depend on the site numbers matching the row.names.

Upvotes: 0

Related Questions