Creating functions within a nested loop-CodePudding

I was hoping to create a function with the if statements in the following code:

data <- data.frame(
  id = c(1, 5, 6, 11, 15, 21),
  intervention = c(2, 2, 2, 1, 1, 1),
  death = c(0, 1, 0, 1, 0, 0)
)

test <- c()
for (i in data$id[which(data$intervention == 1)]) {
  print(paste0("id = ", i, ": "))
  for (j in data$id[which(data$intervention == 2)]) {
    if (data$death[data$id == i] < data$death[data$id == j]) {
      test <- c(test, -1)
    } else if (data$death[data$id == i] > data$death[data$id == j]) {
      test <- c(test, 1)
    } else if (data$death[data$id == i] == data$death[data$id == j]) {
      test <- c(test, 0)
    }
  }
  print(test)
  test <- c()
}

I had tried to do it as follows, however the code is not writing the result to the vector. However if I replaced the return with print, it would print it out. Would anyone have any suggestions on what I might be doing wrong? Many thanks!

first <- function () {
  if(data$death[data$id == i]<data$death[data$id ==j]){
   return (test <- c(test,-1))}
  else if(data$death[data$id == i]>data$death[data$id == j]){
   return (test <- c(test,1))}
  else if(data$death[data$id == i]==data$death[data$id == j]){
   return (test <- c(test,0))} 
}

for (i in data$id[which(data$intervention == 1)]){
  for (j in data$id[which(data$intervention == 2)]){ 
    first()
  }
test
}

CodePudding user response：

The following function returns a list of the wanted vectors.

first <- function(data, interv1 = 1, interv2 = 2) {
  inx <- which(data[["intervention"]] == interv1)
  jnx <- which(data[["intervention"]] == interv2)
  out <- lapply(inx, \(i) {
    sapply(jnx, \(j) sign(data[["death"]][i] - data[["death"]][j]))
  })
  setNames(out, data[["id"]][inx])
}

first(data)
#> $`11`
#> [1] 1 0 1
#> 
#> $`15`
#> [1]  0 -1  0
#> 
#> $`21`
#> [1]  0 -1  0

^{Created on 2022-11-22 with reprex v2.0.2}

You can then access the return values as

test <- first(data)

# any of the following extracts the 1st vector
test[['11']]
#> [1] 1 0 1

# notice the backticks
test$`11`
#> [1] 1 0 1

^{Created on 2022-11-22 with reprex v2.0.2}