ui <- shinyUI(fluidPage(
navbarPage("TMDD - Model 6",
tabPanel("Plot",
fluidRow(
column(2,
tabsetPanel(type='tabs',
tabPanel('param1',br(),
sliderInput("kel", label="kel",value=0.08,min=0.02,max=0.12,step=0.005),
sliderInput("ktp", label="ktp",value=0.725,min=0.3625,max=1.45,step=0.0725),
sliderInput("kpt", label="kpt",value=0.902,min=0.451,max=1.804,step=0.0902),
sliderInput("Vc", label="Vc",value=0.04,min=0.02,max=0.08,step=0.004),
br()
),
tabPanel('param2',br(),
sliderInput("keps", label="keps",value=0.17,min=0.085,max=0.34,step=0.017),
sliderInput("kouts", label="kouts",value=17.3,min=8.65,max=34.6,step=1.73),
sliderInput("koffs", label="koffs",value=169,min=84.5,max=338,step=16.9),
sliderInput("kons", label="kons",value=30.2,min=15.1,max=60.4,step=3.02),
sliderInput("Rs0", label="Rs0",value=0.00657,min=0.003285,max=0.01314,step=0.000657),
br()
),
tabPanel('param3',br(),
sliderInput("kepm", label="kepm",value=0.17,min=0.085,max=0.34,step=0.017),
sliderInput("koffm", label="koffm",value=169,min=84.5,max=338,step=16.9),
sliderInput("konm", label="konm",value=30.2,min=15.1,max=60.4,step=3.02),
sliderInput("Rm0", label="Rm0",value=0.003,min=0.001,max=0.01,step=5e-04),
br()
),
tabPanel('adm',br(),
sliderInput("tfd1", label="tfd",value=12,min=0,max=24,step=3),
sliderInput("nd1", label="nd",value=3,min=1,max=10,step=1),
sliderInput("ii1", label="ii",value=28,min=7,max=112,step=7),
sliderInput("amount1", label="amount",value=10,min=0,max=40,step=0.5),
br()
),
br()
)
),
column(2,
br(),
checkboxGroupInput("out1", label="plot 1", choices='Lc', selected='Lc'),
selectInput("x1", label="v.s.",c('time','Lc','Rs','Ps')),
hr(),
checkboxGroupInput("out2", label="plot 2", choices='Rs', selected='Rs'),
selectInput("x2", label="v.s.",c('time','Lc','Rs','Ps')),
hr(),
checkboxGroupInput("out3", label="plot 3", choices='Ps', selected='Ps'),
selectInput("x3", label="v.s.",c('time','Lc','Rs','Ps')),
hr()
),
column(8,br(),
plotOutput("plot"),
br(),
br(),
br(),
br(),
br(),
fluidRow(
column(1),
column(1,checkboxInput("boxref", label="ref.")),
column(3,actionButton("butref", label = "Reset")),
column(7,radioButtons("ilog", "scale", c("linear" = FALSE,"log " = TRUE), inline=TRUE))
)
)
)
),
tabPanel("Model", pre(includeText("model.txt"))),
tabPanel("ui.R", pre(includeText("ui.R"))),
tabPanel("server.R", pre(includeText("server.R")))
)
))
library("mlxR")
library("reshape")
library("gridExtra")
source("shinymlxTools.R")
out1 <- list(name='Lc', time=seq(0,360,by=1))
out2 <- list(name='Rs', time=seq(0,360,by=1))
out3 <- list(name='Ps', time=seq(0,360,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('kel', 'ktp', 'kpt', 'Vc', 'keps', 'kouts', 'koffs', 'kons', 'Rs0', 'kepm', 'koffm', 'konm', 'Rm0'),
value = isolate(c(input$kel, input$ktp, input$kpt, input$Vc, input$keps, input$kouts, input$koffs, input$kons, input$Rs0, input$kepm, input$koffm, input$konm, input$Rm0)))
t1 <- isolate(input$tfd1)
t2 <- isolate(input$ii1)*(isolate(input$nd1)-1)+t1
t.dose <- seq(t1,t2,by=isolate(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('kel', 'ktp', 'kpt', 'Vc', 'keps', 'kouts', 'koffs', 'kons', 'Rs0', 'kepm', 'koffm', 'konm', 'Rm0'),
value = c(input$kel, input$ktp, input$kpt, input$Vc, input$keps, input$kouts, input$koffs, input$kons, input$Rs0, input$kepm, input$koffm, input$konm, input$Rm0))
t1 <- input$tfd1
t2 <- input$ii1*(input$nd1-1)+t1
t.dose <- seq(t1,t2,by=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, aes(x=',xj,',y=',name.fj[k],'),colour="grey",size=0.75)')
eval(parse(text=pj))
}
pj <- paste0('pl <- pl + geom_path(data=res, 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)
print(pl)
if (length(ij)>1){
if (!is.null(input$legend) && input$legend==FALSE)
pl <- pl + theme(legend.position="none")
else
pl <- pl + guides(colour=guide_legend(title=NULL)) + theme(legend.position=c(.9, .8))
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)
}