I'm trying to create a table with values in R using mutate() and case_when(), because the calculations for mutate() can vary depending on multiple conditions of case_when(). But the number of multiple conditions for case_when() also can vary depending on the model I use. Bellow a reproducible example (Source: https://doseresponse.github.io/medrc/articles/medrc.html):
library(medrc)
library(dplyr)
library(tidyr)
data(spinach)
spinach$CURVE <- as.factor(spinach$CURVE)
#I can have a model using LL.4() or LL.3() function (as in 'fct' bellow)
sm1 <- metadrm(SLOPE ~ DOSE,
data=spinach,
fct=LL.3(),
ind=CURVE,
cid2=HERBICIDE,
struct="UN")
#or in other situations
sm1 <- metadrm(SLOPE ~ DOSE,
data=spinach,
fct=LL.4(),
ind=CURVE,
cid2=HERBICIDE,
struct="UN")
#Extracting the coefficients from the model
minor_coef_table <- as.data.frame(sm1$estimates$ind)
minor_coef_table <- cbind(minor_coef_table, sm1$estimates$coefficient)
minor_coef_table <- cbind(minor_coef_table, sm1$estimates$estimate)
colnames(minor_coef_table) <- c("curves","minor_coef", "minor_estimates")
#I need to create a "table" ('pdata') with a calculated column "SLOPE_per_CURVE" in a way that it is independent of the number of levels of CURVE in the data (spinach, in the example).
pdata <- spinach %>%
group_by(CURVE, HERBICIDE) %>%
expand(DOSE=exp(seq(-5, 5, length=50)))
#One of the conditions is the fct used in the model [LL.4() or LL.3()]
#Other conditions are the curve IDs
ncurves <- length(levels(spinach$CURVE))
#This is an IDEA of what I need, but it is not working as the column "SLOPE_per_CURVE is not created
pdata <- pdata %>% mutate(
SLOPE_per_CURVE =
for(i in 1:ncurves){
case_when(
sm1$fct$name == "LL.4" & CURVE == levels(pdata$CURVE)[i] ~ minor_coef_table[(ncurves+i),3]+((minor_coef_table[(2*ncurves+i),3]-minor_coef_table[(ncurves+i),3])/((1+ exp(minor_coef_table[i,3] * (log(DOSE) - log(minor_coef_table[(3*ncurves+i),3])))))),
sm1$fct$name == "LL.3" & CURVE == levels(pdata$CURVE)[i] ~ ((minor_coef_table[(ncurves+i),3])/((1+ exp(minor_coef_table[i,3] * (log(DOSE) - log(minor_coef_table[(2*ncurves+i),3]))))))
)
}
)
#The bellow code gives what I need and is an example of the final desired result, but it is not independent of the number of levels in CURVE as I have to write every condition.
pdata <- pdata %>% mutate(
SLOPE_per_CURVE =
case_when(
sm1$fct$name == "LL.4" & CURVE == levels(pdata$CURVE)[1] ~ minor_coef_table[6,3]+((minor_coef_table[11,3]-minor_coef_table[6,3])/((1+ exp(minor_coef_table[1,3] * (log(DOSE) - log(minor_coef_table[16,3])))))),
sm1$fct$name == "LL.4" & CURVE == levels(pdata$CURVE)[2] ~ minor_coef_table[7,3]+((minor_coef_table[12,3]-minor_coef_table[7,3])/((1+ exp(minor_coef_table[2,3] * (log(DOSE) - log(minor_coef_table[17,3])))))),
sm1$fct$name == "LL.4" & CURVE == levels(pdata$CURVE)[3] ~ minor_coef_table[8,3]+((minor_coef_table[13,3]-minor_coef_table[8,3])/((1+ exp(minor_coef_table[3,3] * (log(DOSE) - log(minor_coef_table[18,3])))))),
sm1$fct$name == "LL.4" & CURVE == levels(pdata$CURVE)[4] ~ minor_coef_table[9,3]+((minor_coef_table[14,3]-minor_coef_table[9,3])/((1+ exp(minor_coef_table[4,3] * (log(DOSE) - log(minor_coef_table[19,3])))))),
sm1$fct$name == "LL.4" & CURVE == levels(pdata$CURVE)[5] ~ minor_coef_table[10,3]+((minor_coef_table[15,3]-minor_coef_table[10,3])/((1+ exp(minor_coef_table[5,3] * (log(DOSE) - log(minor_coef_table[20,3])))))),
sm1$fct$name == "LL.3" & CURVE == levels(pdata$CURVE)[1] ~ ((minor_coef_table[6,3])/((1+ exp(minor_coef_table[1,3] * (log(DOSE) - log(minor_coef_table[11,3])))))),
sm1$fct$name == "LL.3" & CURVE == levels(pdata$CURVE)[2] ~ ((minor_coef_table[7,3])/((1+ exp(minor_coef_table[2,3] * (log(DOSE) - log(minor_coef_table[12,3])))))),
sm1$fct$name == "LL.3" & CURVE == levels(pdata$CURVE)[3] ~ ((minor_coef_table[8,3])/((1+ exp(minor_coef_table[3,3] * (log(DOSE) - log(minor_coef_table[13,3])))))),
sm1$fct$name == "LL.3" & CURVE == levels(pdata$CURVE)[4] ~ ((minor_coef_table[9,3])/((1+ exp(minor_coef_table[4,3] * (log(DOSE) - log(minor_coef_table[14,3])))))),
sm1$fct$name == "LL.3" & CURVE == levels(pdata$CURVE)[5] ~ ((minor_coef_table[10,3])/((1+ exp(minor_coef_table[5,3] * (log(DOSE) - log(minor_coef_table[15,3]))))))
)
)
Edit:
After the answer by M.Viking, this is the solution:
for(i in 1:ncurves){
pdata <- coalesce(pdata %>% mutate(
SLOPE_per_CURVE =
case_when(
sm1$fct$name == "LL.4" & CURVE == levels(pdata$CURVE)[i] ~ minor_coef_table[(ncurves+i),3]+((minor_coef_table[(2*ncurves+i),3]-minor_coef_table[(ncurves+i),3])/((1+ exp(minor_coef_table[i,3] * (log(DOSE) - log(minor_coef_table[(3*ncurves+i),3])))))),
sm1$fct$name == "LL.3" & CURVE == levels(pdata$CURVE)[i] ~ ((minor_coef_table[(ncurves+i),3])/((1+ exp(minor_coef_table[i,3] * (log(DOSE) - log(minor_coef_table[(2*ncurves+i),3]))))))
)
), pdata)
}
I made a toy example of a for loop mutate case_when with the iris dataset
The first complication is in a simple for (j in 1:10){out<-j} loop, the output data is overwritten with each subsequent iteration of j, and in the end, only the results of the 10th run are retained.
Then I learned about the coalesce() function; which combines (merges? unions? joins?) sparse data of equal length (similar to Microsoft Excel's, paste-special "skip blanks" transformation).
In the sample code below, we take the iris dataset, and loop from 1 to 10, and if iris$Sepal.Length (aka iris[,1]) is equal to the loop iteration j, we change the resulting variable (slope) to 100+j.
iris4 <- tibble(iris)
for (j in 1:10) {
iris4 <- coalesce(iris4 %>% mutate(Slope = case_when(Sepal.Length == j ~ 100+j)),iris4)}
table(iris4$Slope)