[LONGITUDINAL]
input = {ka, Tk0, V, k}

EQUATION:
  D  = 100

if t>Tk0
f0=D/(V*Tk0*k)*(1-exp(-k*Tk0))*exp(-k*(t-Tk0))
else
  f0=D/(V*Tk0*k)*(1-exp(-k*t))
end

f1 = f0
f2 = D*ka/(V*(ka-k))*(exp(-k*t) - exp(-ka*t))

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("shinymlxTools.R", tabName = "tools", icon = icon("angle-right"))
              )
  ),
  hr(),
  fluidRow(               
    column(1),
    column(9,
           checkboxGroupInput("out1", label="plot", choices=c('f1','f2'), selected=c('f1','f2')),
           selectInput("x1", label="v.s.",c('time','f1','f2')),hr(),
           strong("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)
    )
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "plot",
            fluidRow(               
              box(width = 3,   status = "primary",
                  sliderInput("ka", label="ka",value=0.5,min=0.1,max=1,step=0.1),
                  numericInput("Tk0", label="Tk0",value=2),
                  selectInput("k", label="k", choices=c(0.05,0.2,0.4),selected=0.2),
                  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("shinymlxTools.R"))
            )
    )
  )
)

dashboardPage(
  dashboardHeader(title = "Compare PK models"),
  sidebar,
  body
)

# source("../../initMlxR.R")
library("mlxR")
library("shinydashboard")
library("reshape")
library("gridExtra")
source("shinymlxTools.R")

f <- list(name=c('f1','f2'), time=seq(0,20,by=0.1))
f <- list(f)
nf <- length(f)
info <- info_res(f)

server <- function(input, output) {
  ref <- reactive({
    input$butref
    p <- list(name  = c('ka', 'Tk0', 'V', 'k'),
              value = isolate(c(input$ka, input$Tk0, 2, as.numeric(input$k))))

    r <- simulx( model     = 'model.txt',
                 parameter = p,
                 output    = f)

    ref <- merge_res(r,f)
    return(ref)
  })
  
  res <- reactive({
    p <- list(name  = c('ka', 'Tk0', 'V', 'k'),
              value = c(input$ka, input$Tk0, 2, as.numeric(input$k)))
                     
    r <- simulx( model     = 'model.txt',
                 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 (!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)
}

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