简体   繁体   中英

Linear combination of a set of vectors and a function of vectors in R

Suppose we have three vectors x1, x2, x3 and also we have four vectors a0, a1, a2, a3 which we call coefficients.

x1 <- rnorm(10); x2 <- rnorm(10); x3 <- rnorm(10);
a0 <- runif(25); a1 <- runif(25); a2 <- runif(25); a3 <- runif(25);

I want to compute the following data frames L0, L1, L2, L3 (all of them will have 10 rows and 25 columns)

L0<-data.frame(matrix(0,nrow=10,ncol=25))
L1<-data.frame(matrix(0,nrow=10,ncol=25))
L2<-data.frame(matrix(0,nrow=10,ncol=25))
L3<-data.frame(matrix(0,nrow=10,ncol=25))

for (i in 1:10){
   L0[i,] <- a0 + mean(a1)*x1[i] + mean(a2)*x2[i] + mean(a3)*x3[i]
   L1[i,] <- mean(a0) + a1*x1[i] + mean(a2)*x2[i] + mean(a3)*x3[i]
   L2[i,] <- mean(a0) + mean(a1)*x1[i] + a2*x2[i] + mean(a3)*x3[i]
   L3[i,] <- mean(a0) + mean(a1)*x1[i] + mean(a2)*x2[i] + a3*x3[i] 
 }

I'm wondering how to make the coefficients a were used as vectors when I compute the corresponding L, but remain the rest of coefficients in that computation as a function of those coefficients (the mean in this example). Is there in R a better way to do what the last code does? Namely, compute each L through the set of vectors a so that in the computation of L0 , the coefficient a0 is used with all its elements, but the others a1 , a2 , a3 are their correspondent mean; in the computation of L1 the coefficient a1 is used with all its elements, but the others a0 , a2 , a3 are their correspondent mean, and so on.

Consider a nested lapply and mapply approach that ultimately creates a list of dataframes and as shown each element is equivalent to original L's. Two versions are demonstrated below.

Longer version (using if logic)

alternative_means_sums <- function(a,b,c,d) {  
  if (d == 1) {
    vec <- a0 + mean(a1)*a + mean(a2)*b + mean(a3)*c
  }
  if (d == 2) {
    vec <- mean(a0) + a1*a + mean(a2)*b + mean(a3)*c
  }
  if (d == 3) {
    vec <- mean(a0) + mean(a1)*a + a2*b + mean(a3)*c
  }
  if (d == 4) {
    vec <-mean(a0) + mean(a1)*a + mean(a2)*b + a3*c
  }
  return(vec)
}

dfList <- lapply(seq(4), function(i)
  data.frame(t(mapply(alternative_means_sums, x1, x2, x3, i))))

all.equal(dfList[[1]], L0)
# [1] TRUE
all.equal(dfList[[2]], L1)
# [1] TRUE
all.equal(dfList[[3]], L2)
# [1] TRUE
all.equal(dfList[[4]], L3)
# [1] TRUE

Shorter version (collect all means in list, then by position remove unneeded mean and add the non-mean factor)

a_list <- list(a0, a1, a2, a3)      # OR:   mget(ls(pattern="^a[0-9]$"))

alternative_means_sums <- function(a,b,c,d) { 
  args <- list(1,a,b,c)
  tmp <- c(mean(a0), mean(a1)*a, mean(a2)*b, mean(a3)*c)[-d]      
  vec <- sum(tmp) + a_list[[d]]*args[[d]]

  return(vec)
}

dfList2 <- lapply(seq(4), function(i)
  data.frame(t(mapply(alternative_means_sums, x1, x2, x3, i))))

all.equal(dfList2[[1]], L0)
# [1] TRUE
all.equal(dfList2[[2]], L1)
# [1] TRUE
all.equal(dfList2[[3]], L2)
# [1] TRUE
all.equal(dfList2[[4]], L3)
# [1] TRUE

Here's an approach using the dplyr package. First, some set up:

library(dplyr)
A <- data.frame(a0, a1, a2, a3)
X <- cbind(1, x1, x2, x3)

Now we create a function to create the L dataframes.

L <- function(i, mat = A, fun = mean) {
  if (i + 1 > ncol(mat)) 
    stop("i must be less than or equal to number of 'a' vectors")
  out <- mutate_at(mat, seq(ncol(mat))[-(i + 1)], fun)
  out <- as.data.frame(X %*% t(as.matrix(out)))
  colnames(out) <- paste0("X", seq(nrow(mat)))
  out
}

The mutate_at function transforms the values in each column in the A dataframe to the column mean, except for the column indicated in i . We then use matrix multiplication to get the desired output. The last step renames the columns in the output in the format X1, X2, ..., X25 to match the original L0, L1 etc dataframes.

So we have

all.equal(L(0), L0)
[1] TRUE

We can also do

out <- lapply(0:3, L)
all.equal(out[[1]], L0)
# [1] TRUE
all.equal(out[[2]], L1)
# [1] TRUE

and so on.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM