model.txt
[LONGITUDINAL]
input={Tk0,V,Cl,Imax,E0,IC50,kout,alpha,beta}
EQUATION:
Cc = pkmodel(Tk0, V, Cl)
E_0 = E0
kin = E0*kout
ddt_E = kin*(1-Imax*Cc/(Cc+IC50)) - kout*E
h = (alpha/1000)*exp(beta*E)
H_0 = 0
ddt_H = h
S = exp(-H)
ui.R
library(shinydashboard)
sidebar <- dashboardSidebar(
hr(),
sidebarMenu(id="tabs",
menuItem("Plot", tabName = "plot", icon = icon("line-chart"), selected=TRUE),
menuItem("Codes", icon = icon("file-text-o"),
menuSubItem("Mlxtran", tabName = "mlxtran", icon = icon("angle-right")),
menuSubItem("ui.R", tabName = "ui", icon = icon("angle-right")),
menuSubItem("server.R", tabName = "server", icon = icon("angle-right")),
menuSubItem("shinymlx_tools.R", tabName = "tools", icon = icon("angle-right"))
)
),
hr(),
fluidRow(
column(1),
column(9,
checkboxGroupInput("out1", label="plot 1", choices='Cc', selected='Cc'),
hr(),
checkboxGroupInput("out2", label="plot 2", choices='E', selected='E'),
hr(),
checkboxGroupInput("out3", label="plot 3", choices='S', selected='S'),
hr(),
h5("add"),
fluidRow(
column(5,checkboxInput("boxref", label="ref.")),
column(4,actionButton("butref", label = "Reset"))
),
hr(),
radioButtons("ilog", "scale", c("linear" = FALSE,"log" = TRUE), inline=TRUE)
)
),
hr()
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "plot",
fluidRow(
box(width = 3, status = "primary",
tabsetPanel(type='pills',
tabPanel('param1',br(),
sliderInput("Tk0", label="Tk0",value=3,min=1.5,max=6,step=0.3),
sliderInput("V", label="V",value=10,min=5,max=20,step=1),
sliderInput("Cl", label="Cl",value=1,min=0.5,max=2,step=0.1),
br()
),
tabPanel('param2',br(),
sliderInput("Imax", label="Imax",value=0.8,min=0.4,max=1.6,step=0.08),
sliderInput("E0", label="E0",value=100,min=50,max=200,step=10),
sliderInput("IC50", label="IC50",value=4,min=2,max=8,step=0.4),
sliderInput("kout", label="kout",value=0.1,min=0.05,max=0.2,step=0.01),
sliderInput("alpha", label="alpha",value=0.5,min=0.25,max=1,step=0.05),
sliderInput("beta", label="beta",value=0.02,min=0.01,max=0.04,step=0.002),
br()
),
tabPanel('adm',br(),
sliderInput("tfd1", label="tfd",value=4,min=0,max=24,step=1),
numericInput("nd1", label="nd",value=20,min=10,max=25),
selectInput("ii1", label="ii", choices=c(6,12,18,24),selected=12),
sliderInput("amount1", label="amount",value=40,min=0,max=100,step=10),
br()
)
)
),
box(width = 9, height=530, status = "primary",
plotOutput("plot")
)
)
),
tabItem(tabName = "mlxtran",
box( width = NULL, status = "primary", solidHeader = TRUE, title="model.txt",
pre(includeText("model.txt"))
)
),
tabItem(tabName = "ui",
box( width = NULL, status = "primary", solidHeader = TRUE, title="ui.R",
pre(includeText("ui.R"))
)
),
tabItem(tabName = "server",
box( width = NULL, status = "primary", solidHeader = TRUE, title="server.R",
pre(includeText("server.R"))
)
),
tabItem(tabName = "tools",
box( width = NULL, status = "primary", solidHeader = TRUE, title="server.R",
pre(includeText("shinymlx_tools.R"))
)
)
# tabItem(tabName = "about", includeMarkdown("../../about/about.Rmd"))
)
)
dashboardPage(
dashboardHeader(title = "Joint model"),
sidebar,
body
)
server.R
library(shinydashboard)
source("../../initMlxR.R") #comment this line to run this application on a personal computer
library("reshape")
library("gridExtra")
source("shinymlx_tools.R")
out1 <- list(name='Cc', time=seq(0,200,by=1))
out2 <- list(name='E', time=seq(0,200,by=1))
out3 <- list(name='S', time=seq(0,200,by=1))
f <- list(out1, out2, out3)
nf <- length(f)
info <- info_res(f)
server <- function(input, output) {
ref <- reactive({
input$butref
p <- list(name = c('Tk0', 'V', 'Cl', 'Imax', 'E0', 'IC50', 'kout', 'alpha', 'beta'),
value = isolate(c(input$Tk0, input$V, input$Cl, input$Imax, input$E0, input$IC50, input$kout, input$alpha, input$beta)))
t1 <- isolate(input$tfd1)
t2 <- isolate(as.numeric(input$ii1))*(isolate(input$nd1)-1)+t1
t.dose <- seq(t1,t2,by=isolate(as.numeric(input$ii1)))
adm <- list(time=t.dose, amount=isolate(input$amount1))
r <- simulx( model = 'model.txt',
treatment = adm,
parameter = p,
output = f)
ref <- merge_res(r,f)
return(ref)
})
res <- reactive({
p <- list(name = c('Tk0', 'V', 'Cl', 'Imax', 'E0', 'IC50', 'kout', 'alpha', 'beta'),
value = c(input$Tk0, input$V, input$Cl, input$Imax, input$E0, input$IC50, input$kout, input$alpha, input$beta))
t1 <- input$tfd1
t2 <- as.numeric(input$ii1)*(input$nd1-1)+t1
t.dose <- seq(t1,t2,by=as.numeric(input$ii1))
adm <- list(time=t.dose, amount=input$amount1)
r <- simulx( model = 'model.txt',
treatment = adm,
parameter = p,
output = f)
res <- merge_res(r,f)
return(res)
})
output$plot <- renderPlot({
res=res()
ref=ref()
gr.txt <- "grid.arrange("
for (j in (1:length(f))){
xj <- "time"
fj <- f[[j]]
name.fj <- fj$name
eval(parse(text=paste0("inputyj=input$out",j)))
i.plot=FALSE
if (!is.null(inputyj)){
ij <- which(name.fj %in% inputyj)
if (length(ij>0)){
eval(parse(text=paste0("inputxj=input$x",j)))
if (!is.null(inputxj))
xj <- inputxj
}
i.plot=TRUE
}
else if (is.null(inputyj) & length(f)==1){
ij=1
i.plot=TRUE
}
if (i.plot){
pl <- ggplotmlx()
nfj <- length(name.fj)
for (k in (1:nfj)){
if (k %in% ij){
if (input$boxref==TRUE){
pj <- paste0('pl <- pl + geom_path(data=ref[[j]], aes(x=',xj,',y=',name.fj[k],'),colour="grey",size=0.75)')
eval(parse(text=pj))
}
pj <- paste0('pl <- pl + geom_path(data=res[[j]], aes(x=',xj,',y=',name.fj[k],',colour="',info[[j]]$colour[k],'"),size=0.75)')
eval(parse(text=pj))
}
}
pl <- pl + scale_colour_manual(values=info[[j]]$values, labels=info[[j]]$labels)
if (length(ij)>1){
if (input$legend==TRUE)
pl <- pl + guides(colour=guide_legend(title=NULL)) + theme(legend.position=c(.9, .8))
else
pl <- pl + theme(legend.position="none")
pl <- pl + ylab("")
}else{
pl <- pl + theme(legend.position="none")
}
if (input$ilog==TRUE)
pl=pl + scale_y_log10()
eval(parse(text=paste0("pl",j," <- pl")))
gr.txt <- paste0(gr.txt,"pl",j,",")
}
}
gr.txt <- paste0(gr.txt,"ncol=1)")
eval(parse(text=gr.txt))
}, height = 500)
}
server.R
gg_color_hue <- function(n) {
hues = seq(15, 375, length=n+1)
hcl(h=hues, l=65, c=100)[1:n]}
info_res <- function(f){
if (!is.null(names(f)))
f <- list(f)
nf <- length(f)
info <- list()
for (k in (1:nf)){
fk <- f[[k]]
nk <- length(fk$name)
lk <- as.character(1:nk)
valk <- gg_color_hue(nk)
names(valk) <- lk
labk <- fk$name
names(labk) <- lk
info[[k]] <- list(values=valk, labels=labk, colour=lk)
}
return(info)
}
merge_res <- function(r1,f){
r2 <- list()
nf <- length(f)
for (j in (1:nf)){
fj <- f[[j]]
nj <- length(fj$name)
r <- r1[[fj$name[1]]]
if (nj>1){
for (k in (2:nj)){
rk <- r1[[fj$name[k]]]
r <- merge(r,rk)
}
}
r2[[j]] <- r
}
return(r2)
}