Replace nested for loops in printing long output - r

Question

I have the data below:
Kd1Par<-as.matrix(c(1,2,3))
Kd2Par<-as.matrix(c(1,2,3))
and the algorithm which uses nested for loops:
for (i in 1:length(Kd1Par)){
for (j in 1:length(Kd2Par)){
Kd1 <- Kd1Par[i]
Kd2 <- Kd2Par[j]
print(c(Kd1 = Kd1Par[i], Kd2 = Kd2Par[j]))
myDose[i, j] <- 10
print(c(Dose = myDose[i,j]))
}}
in order to give me this output :
Kd1 Kd2
1 1
Dose
10
Kd1 Kd2
1 2
Dose
10
Kd1 Kd2
1 3
Dose
10
Kd1 Kd2
2 1
Dose
10
Kd1 Kd2
2 2
Dose
10
Kd1 Kd2
2 3
Dose
10
Kd1 Kd2
3 1
Dose
10
Kd1 Kd2
3 2
Dose
10
Kd1 Kd2
3 3
Dose
10
The problem is that my real dataset is too big and the for loops is an efficient method but very slow so I would like to replace it with a method that gives me exactly the same result as above. Note that myDose[i, j] <- 10 is not always 10 in my real project but comes from another calculation that gives every time another result but here I set is as 10 in order to simplify the problem.
# my app in case it makes more sense to understand the issue
library(deSolve)
library(caTools)
library(shiny)
library(ggplot2)
library(ggpubr)
library(minpack.lm)
library(reshape2)
library(pracma)
ui <- fluidPage(
# fluidRow(title='Schematic of Two Memb Bound Target ',
# img(src='twoMemBound.png',width='100%')),
plotOutput('PKPlot'),
actionButton(inputId = "click",
label = "Run"),
fluidRow(
column(4,
h6("Dosing regimen Parameters",style = "color:red",align="center"),
sliderInput("nIter", label = h6("Contour Smoothness"),
min = 2, max = 15, value = 3),
sliderInput("reqMinInh", label = h6("Minimum Inhibition"),
min = 10, max = 100, value = 90),
sliderInput("nd", label = h6("Number of Doses"),
min = 3, max = 100, value = 4),
# sliderInput("endTime", label = h6("Simulation time in Days"),
# min = 0, max = 500, value = 77),
sliderInput("tau", label = h6("Dosing interval in Days"),
min = 0.1, max = 50, value = 7),
sliderInput("BW", label = h6("Bodyweight in Kg"),
min = 60, max = 100, value = 70)
),
column(4,
h6("Drug Parameters",style = "color:red",align="center"),
sliderInput("CL", label = h6("Drug Clearance (L/day)"),
min = 0.1, max = 0.3, value = 0.24),
sliderInput("Vp", label = h6("Volume of Plasma Comp (L)"),
min = 0.1, max = 3, value = 3),
sliderInput("Kon1", label = h6("Drug Affinity for Target 1 (1/(nmol/L)/day)"),
min = 0.1, max = 2, value = 1.3824),
sliderInput("Kon2", label = h6("Drug Affinity for Target 2 (1/(nmol/L)/day)"),
min = 0.1, max = 2, value = 1.3824),
sliderInput("MW", label = h6("Molecular Weight in da"),
min = 50e3, max = 200e3, value = 150e3)
# sliderInput("Vph", label = h6("Volume of Peripheral Comp (L)"),
# min = 0.1, max = 5, value = 3.1),
# sliderInput("Vt", label = h6("Volume of Tissue Comp (L)"),
# min = 0.1, max = 0.2, value = 0.192),
# sliderInput("k_01", label = h6("First Order Absorption Rate (1/day)"),
# min = 0.1, max = 2, value = 1),
),
column(4,
h6("Target Parameters",style = "color:red",align="center"),
sliderInput("R01", label = h6("Baseline Conc of Target 1 (nmol/L)"),
min = 0.01, max = 10, value = 0.1),
sliderInput("R02", label = h6("Baseline Conc of Target 2 (nmol/L)"),
min = 0.01, max = 10, value = 0.1),
sliderInput("HL1", label = h6("Half-life of Target 1 (min)"),
min = 0.01, max = 100, value = 100),
sliderInput("HL2", label = h6("Half-life of Target 2 (min)"),
min = 0.01, max = 100, value = 100)
)
)
)
server <- function(input, output) {
v <- reactiveValues(doPlot = FALSE)
observeEvent(input$click, {
v$doPlot <- input$click
})
output$PKPlot <- renderPlot({
if (v$doPlot == FALSE) return()
isolate({
reqMinInh <- input$reqMinInh # (%) Min inhibition of Target
nd <- input$nd # Number of doses
tau <- input$tau
endTime <- (nd+1)*tau
BW <- input$BW
MW <- input$MW
nIter <- input$nIter
Kd1Par <- logspace(-1.98,1.698,n = nIter)
Kd2Par <- logspace(-1.98,1.698,n = nIter)
myDose <- matrix(c(0), nrow= length(Kd1Par), ncol = length(Kd2Par))
Kon_m1 <- input$Kon1 # (1/(nmol/L)/day)
Kon_m2 <- input$Kon2 # (1/(nmol/L)/day)
Base1 <- input$R01
Base2 <- input$R02
HL1 <- input$HL1
HL2 <- input$HL2
Kint_m1 <- 0.693*60*24/HL1 # (1/day)
Kint_m2 <- 0.693*60*24/HL2 # (1/day)
Kdeg_m1 <- Kint_m1 # (1/day)
Kdeg_m2 <- Kint_m2 # (1/day)
Ksyn_m1 <- Base1*Kdeg_m1 # (nmol/L/day)
Ksyn_m2 <- Base2*Kdeg_m2 # (nmol/L/day)
Vp <- input$Vp # (L) Ref: Vaishali et al. 2015
Vph <- 3.1 # (L) Ref: Tiwari et al. 2016
Vt <- 0.192 # (L) Spleen, Ref: Davis et al. 1993
k_01 <- 1 # (1/day) Ref: Leonid Gibiansky
CL <- input$CL # (L/day) Ref: Leonid Gibiansky
K_el <- CL/Vp # (1/day)
k_pph <- 0.186 # (1/day) Ref: Tiwari et al. 2016
k_php <- 0.184 # (1/day) Ref: Tiwari et al. 2016
Ktp <- 0.26 # (1/day)
Kpt <- 0.004992 # (1/day)
times <- seq(from = 0, to = endTime, by =0.1)
yInit <- c(Ap = 0.0, Dp = 0.0, Dt = 0.0,
M1 = Base1, M2 = Base2,
DtM1 = 0.0, DtM2 = 0.0, DtM1M2 = 0.0, Dph = 0.0)
derivs_pk1 <- function(t, y, parms) {
with(as.list(c(y,parms)),{
dAp_dt <- -k_01*Ap
dDp_dt <- k_01*Ap/Vp -K_el*Dp +Vt/Vp*Ktp*Dt -Kpt*Dp +Vph/Vp*k_php*Dph -k_pph*Dp
dDt_dt <- Vp/Vt*Kpt*Dp -Ktp*Dt -Kon_m1*Dt*M1 +Koff_m1*DtM1 -Kon_m2*Dt*M2 +Koff_m2*DtM2
dM1_dt <- Ksyn_m1 -Kdeg_m1*M1 -Kon_m1*Dt*M1 +Koff_m1*DtM1 -Kon_m1*DtM2*M1 +Koff_m1*DtM1M2
dM2_dt <- Ksyn_m2 -Kdeg_m2*M2 -Kon_m2*Dt*M2 +Koff_m2*DtM2 -Kon_m2*DtM1*M2 +Koff_m2*DtM1M2
dDtM1_dt <- -Kint_m1*DtM1 -Koff_m1*DtM1 +Kon_m1*Dt*M1 -Kon_m2*DtM1*M2 +Koff_m2*DtM1M2
dDtM2_dt <- -Kint_m2*DtM2 -Koff_m2*DtM2 +Kon_m2*Dt*M2 -Kon_m1*DtM2*M1 +Koff_m1*DtM1M2
dDtM1M2_dt <- Kon_m2*DtM1*M2 -Koff_m2*DtM1M2 +Kon_m1*DtM2*M1 -Koff_m1*DtM1M2 -Kint_m1*DtM1M2 -Kint_m2*DtM1M2
dDph_dt <- Vp/Vph*k_pph*Dp - k_php*Dph
list(c(dAp_dt,dDp_dt,dDt_dt,dM1_dt,dM2_dt,dDtM1_dt,dDtM2_dt,dDtM1M2_dt,dDph_dt))
})
}
ssq <- function(parmsToOptm){
Dose <- parmsToOptm[1]
injectEvents <- data.frame(var = "Ap",
time = seq(0,tau*(nd-1),tau),
value = Dose*1e6*BW/MW, # (nmol)
method = "add")
pars_pk1 <- c()
qss_pk10<-ode(times = times, y = yInit, func =derivs_pk1, parms = pars_pk1,events = list(data = injectEvents))
qss_pk1<- data.frame(qss_pk10)
temp <- qss_pk1[qss_pk1$time>tau*(nd-2)&qss_pk1$time<tau*(nd-1),]
inh1 <- (1-temp$M1/Base1)*100
inh2 <- (1-temp$M2/Base2)*100
if(min(inh1,inh2) %in% inh1) {
currMinInh <- inh1
} else {currMinInh <-inh2}
ssqres = currMinInh - reqMinInh
return(ssqres)
}
for (i in 1:length(Kd1Par)){
for (j in 1:length(Kd2Par)){
Kd1 <- Kd1Par[i]
Kd2 <- Kd2Par[j]
print(c(Kd1 = Kd1Par[i], Kd2 = Kd2Par[j]))
Koff_m1 <- Kon_m1*Kd1 # (1/day)
Koff_m2 = Kon_m2*Kd2 # (1/day)
# Initial guess
parmsToOptm <- c(10)
fitval<-nls.lm(par=parmsToOptm,fn=ssq,control = nls.lm.control(ftol = sqrt(.Machine$double.eps),
ptol = sqrt(.Machine$double.eps), gtol = 0, diag = list(), epsfcn = parmsToOptm[1]/100,
factor = 100, maxfev = integer(), maxiter = 50, nprint = 0))
myDose[i, j] <- c(coef(fitval))
print(c(Dose = myDose[i,j]))
}
}
KdMat <- expand.grid(Kd1Par,Kd2Par)
temp1 <- melt(myDose)
myDoseFormat <- data.frame(Kd1=KdMat$Var1, Kd2 = KdMat$Var2, Dose = temp1$value)
minDose <- myDoseFormat[myDoseFormat$Dose == min(myDoseFormat$Dose),]
Kd1 <- minDose$Kd1
Kd2 <- minDose$Kd2
Koff_m1 <- Kon_m1*Kd1 # (1/day)
Koff_m2 = Kon_m2*Kd2 # (1/day)
Dose <- minDose$Dose
injectEvents <- data.frame(var = "Ap",
time = seq(0,tau*(nd-1),tau),
value = Dose*1e6*BW/MW, # (nmol)
method = "add")
pars_pk1 <- c()
qss_pk10<-ode(times = times, y = yInit, func =derivs_pk1, parms = pars_pk1,events = list(data = injectEvents))
qss_pk1<- data.frame(qss_pk10)
mytheme_grey <- theme_grey(base_size=18)+theme(plot.caption=element_text(size=8, colour="grey60"))
p1 <- ggplot(myDoseFormat, aes(x = Kd1, y = Kd2, z = Dose)) +
geom_raster(aes(fill = Dose), interpolate=T) +
scale_x_log10() + scale_y_log10() +
labs(title = "Contours of dose (mg/kg)", x="Target-1 Kd (nM)",y="Target-2 Kd (nM)") +
guides(fill = guide_colorbar(title = "Dose (mg/kg)")) +
theme(legend.position=c(0.9, 0.75))
p2 <- ggplot(qss_pk1,aes(x=time/7)) +
geom_line(aes(y=Dp)) +
labs(x="Time (weeks)",y="Drug Conc (nmol/L)") +
mytheme_grey
cols <- c("Target 1" ="red", "Target 2" = "blue")
p3 <- ggplot(qss_pk1,aes(x=time/7)) +
geom_line(aes(y=M1, colour = "Target 1"), size = 1.5, linetype = 1) +
geom_line(aes(y=M2, colour = "Target 2"), size = 1.5, linetype = 2) +
labs(x="Time (weeks)",y="Target Conc (nmol/L)") +
scale_colour_manual(name = "Targets", values = cols)+
mytheme_grey
p4 <- ggplot(qss_pk1,aes(x=time/7)) +
geom_line(aes(y= (1-M1/Base1)*100, colour = "Target 1"), size = 1.5, linetype = 1) +
geom_line(aes(y= (1-M2/Base2)*100, colour = "Target 2"), size = 1.5, linetype = 2) +
labs(x="Time (weeks)",y="Target Occupancy (%)") +
scale_colour_manual(name = "Targets", values = cols)+
mytheme_grey
ggarrange(p1,p2,p3,p4,labels=c("A","B","C","D"), ncol=4,nrow=1)
})
})
}
shinyApp(ui = ui, server = server)

Answer 1

Do you need a loop?
# Create a data frame of all combinations
df <- expand.grid(Kd1Par = c(1,2,3), Kd2Par = c(1,2,3))
# Load libraries
library(dplyr)
library(purrr)
# If function is vectorised
df %>%
mutate(Dose = MyFunction(Kd1Par, Kd2Par))
# If function is not vectorised
df %>%
mutate(Dose = map2_dbl(Kd1Par, Kd2Par, MyFunction))
Here, I create all possible combinations of Kd1Par and Kd2Par and then run the dose function, which I called MyFunction.
For example,
# Example dose function
MyFunction <- function(x, y)x + y
would give something like
# Kd1Par Kd2Par Dose
# 1 1 1 2
# 2 2 1 3
# 3 3 1 4
# 4 1 2 3
# 5 2 2 4
# 6 3 2 5
# 7 1 3 4
# 8 2 3 5
# 9 3 3 6