model.txt

[LONGITUDINAL] 
input={ka,V,Cl,ke0,Imax,IC50,S0,kout}

EQUATION:
{Cc, Ce}  = pkmodel(ka, V, Cl, ke0)

Ec = Imax*Cc/(Cc+IC50)
E1 = S0*(1 - Ec)

Ee = Imax*Ce/(Ce+IC50)
E2 = S0*(1 - Ee)

E3_0 = S0 
ddt_E3 = kout*((1-Ec)*S0- E3)  

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'),

selectInput("x1", label="v.s.",c('time','Cc','E1','E2','E3')),
hr(),
checkboxGroupInput("out2", label="plot 2", choices=c('E1','E2','E3'), selected=c('E1','E2','E3')),

selectInput("x2", label="v.s.",c('time','Cc','E1','E2','E3')),
hr(),
h5("add"),
checkboxInput("legend", label="legend", value=TRUE),

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("ka", label="ka",value=0.5,min=0.25,max=1,step=0.05),
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("ke0", label="ke0",value=0.1,min=0.05,max=0.2,step=0.01),
sliderInput("Imax", label="Imax",value=0.5,min=0.25,max=1,step=0.05),
sliderInput("IC50", label="IC50",value=0.03,min=0.015,max=0.06,step=0.003),
sliderInput("S0", label="S0",value=100,min=50,max=200,step=10),
sliderInput("kout", label="kout",value=0.1,min=0.05,max=0.2,step=0.01),
br()
),
tabPanel('adm',br(),
sliderInput("tfd1", label="tfd",value=5,min=2.5,max=10,step=0.5),
sliderInput("nd1", label="nd",value=15,min=7.5,max=30,step=1.5),
sliderInput("ii1", label="ii",value=12,min=6,max=24,step=1.2),
sliderInput("amount1", label="amount",value=1,min=0.5,max=2,step=0.1),
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 = "PKPD models"),
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,250,by=1))
    out2 <- list(name=c('E1','E2','E3'), time=seq(0,250,by=1))
    f  <- list(out1, out2)

nf <- length(f)
info <- info_res(f)

server <- function(input, output) {
    ref <- reactive({
    input$butref 
    p <- list(name  = c('ka', 'V', 'Cl', 'ke0', 'Imax', 'IC50', 'S0', 'kout'),
              value = isolate(c(input$ka, input$V, input$Cl, input$ke0, input$Imax, input$IC50, input$S0, input$kout)))

    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('ka', 'V', 'Cl', 'ke0', 'Imax', 'IC50', 'S0', 'kout'),
              value = c(input$ka, input$V, input$Cl, input$ke0, input$Imax, input$IC50, input$S0, input$kout))

    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)
        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
  }

  r3 <- r2[[1]]
  if (nf>1){
    for (k in (2:nf))
      r3 <- merge(r3,r2[[k]])
  }
  return(r3)
}