Nothing
library(shiny)
library(PopED)
library(rhandsontable)
function(input, output, session) {
values = reactiveValues(
hot_dose_table = data.frame(group = 1L,
amount = 0,
time = 0,
duration = 0,
n = 1L,
tau = 0,
cmt = 1L,
stringsAsFactors = FALSE)
)
model_name <- reactive({
mod_name <- NULL
if(input$pk_mod) mod_name <- paste(input$struct_PK_model,"sd",input$param_PK_model,sep=".")
if(input$pd_mod){
if(!input$pk_mod){
mod_name <- paste0(input$struct_PD_model)
} else {
mod_name <- paste(mod_name,input$link_fcn,input$struct_PD_model,sep=".")
}
}
return(mod_name)
})
setHot = function(x) values[["hot"]] = x
data = reactive({
if (!is.null(input$hot)) {
DF = hot_to_r(input$hot)
names(DF) <- c("name",
"pop_val" ,
"pop_fixed",
"bsv_model",
"variance" ,
"var_fixed",
"covariate")
} else {
if (is.null(values[["DF"]])){
mod_name <- model_name()
name <- codetools::findGlobals(eval(parse(text=mod_name)),merge=F)$variables
covariate <- name %in% c("Dose","DOSE","dose","tau","TAU","Tau")
bsv_model <- rep("exp",length(name))
df <- data.frame(name=name,
pop_val = runif(length(name)),
pop_fixed=FALSE,
bsv_model=factor(bsv_model,levels = c("exp","add","prop","none"),ordered=TRUE),
variance = rep(0.09,length(name)),
var_fixed=FALSE,
covariate=covariate,
stringsAsFactors = FALSE)
#no_eta <- 1:length(parameter_names_ff)*FALSE
#names(no_eta) <- parameter_names_ff
#no_eta[parameter_names_ff %in% no_etas] <- TRUE
# DF = data.frame(val = 1:10, bool = TRUE, nm = LETTERS[1:10],
# dt = seq(from = Sys.Date(), by = "days", length.out = 10),
# stringsAsFactors = F)
DF = df
} else{
DF = values[["DF"]]
}
}
DF[DF[,"covariate"],"variance"] <- 0
#DF[DF[,"covariate"],"var_fixed"] <- TRUE
DF[DF[,"covariate"],"bsv_model"] <- "none"
DF[DF[,"bsv_model"]=="none","variance"] <- 0
#DF[DF[,"bsv_model"]=="none","var_fixed"] <- TRUE
DF[DF[,"variance"]==0,"var_fixed"] <- TRUE
values[["DF"]] = DF
DF
})
output$hot <- renderRHandsontable({
DF = data()
if (!is.null(DF))
rhandsontable(DF, useTypes = TRUE,
#stretchH = "all", stretchV="all",
overflow="visible",
colHeaders = c("Parameter names","Pop. value","Fix pop. value",
"BSV model", "BSV Value", "Fix BSV value", "Treat as \ndesign variable")
#highlightCol = TRUE, highlightRow = TRUE
)
})
param_names <- reactive({
mod_name <- model_name()
name <- codetools::findGlobals(eval(parse(text=mod_name)),merge=F)$variables
names_par <- name[!name %in% c("Dose","DOSE","dose","tau","TAU","Tau")]
})
#values = reactiveValues()
setHot2 = function(x) values[["hot2"]] = x
output$hot2 = renderRHandsontable({
if (!is.null(input$hot2)) {
DF = hot_to_r(input$hot2)
par_name <- param_names()
if(!all(par_name %in% DF$name)){
new_par_name <- par_name[!(par_name %in% DF$name)]
old_par_name <- par_name[(par_name %in% DF$name)]
bsv_model <- rep("Exponential",length(new_par_name))
df <- data.frame(name=new_par_name,
bsv_model=factor(bsv_model,
levels = c("Exponential",
"Additive",
"Proportional",
"None"),
ordered=TRUE),
stringsAsFactors = FALSE)
df$bsv_model[df$name %in% c("Favail","F")] <- "None"
DF = rbind(dplyr::filter(DF,name %in% old_par_name),df)
}
} else {
par_name <- param_names()
bsv_model <- rep("Exponential",length(par_name))
df <- data.frame(name=par_name,
bsv_model=factor(bsv_model,
levels = c("Exponential",
"Additive",
"Proportional",
"None"),
ordered=TRUE),
stringsAsFactors = FALSE)
df$bsv_model[df$name %in% c("Favail","F")] <- "None"
DF = df
}
setHot2(DF)
rhandsontable(DF) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, overflow="visible")
})
# output$table_tmp <- renderTable(DF <- values[["hot2"]])
setHot3 = function(x) values[["hot3"]] = x
output$hot3 = renderRHandsontable({
if (!is.null(input$hot3)) {
DF = hot_to_r(input$hot3)
} else {
par_names <- param_names()
df <- data.frame(name=par_names,
value = runif(length(par_names)),
fixed=FALSE,
stringsAsFactors = FALSE)
df$fixed[df$name %in% c("Favail","F")] <- TRUE
df$value[df$name %in% c("Favail","F")] <- 1
DF = df
}
setHot3(DF)
rhandsontable(DF) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, overflow="visible")
})
setHot4 = function(x) values[["hot4"]] = x
output$hot4 = renderRHandsontable({
par_names <- values[["hot2"]] %>% dplyr::filter(bsv_model!="None") %>% dplyr::select(name)
if (!is.null(input$hot4)) {
MAT = hot_to_r(input$hot4)
update <- FALSE
if(length(dimnames(MAT)[[1]])!=length(par_names[[1]])){
update <- TRUE
} else {
if(any(dimnames(MAT)[[1]]!=par_names[[1]])) update <- TRUE
}
if(update){
MAT1 <- zeros(nrow(par_names))
diag(MAT1) <- 0.09
dimnames(MAT1) <- c(par_names,par_names)
old_names <- dimnames(MAT)[[1]]
still_here_old_names <- old_names[old_names %in% par_names[[1]]]
MAT1[still_here_old_names,still_here_old_names] <- MAT[still_here_old_names,still_here_old_names]
MAT <- MAT1
}
} else {
#par_names <- values[["hot2"]] %>% dplyr::filter(bsv_model!="None") %>% dplyr::select(name)
MAT <- zeros(nrow(par_names))
diag(MAT) <- 0.09
dimnames(MAT) <- c(par_names,par_names)
}
setHot4(MAT)
rhandsontable(MAT) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, overflow="visible") %>%
hot_cols(renderer = "
function (instance, td, row, col, prop, value, cellProperties) {
Handsontable.renderers.TextRenderer.apply(this, arguments);
if (row == col) {
td.style.background = 'lightgrey';
} else if (col > row) {
td.style.background = 'grey';
td.style.color = 'grey';
} else if (value != 0) {
td.style.background = 'lightgreen';
} else if (value > 0.75) {
td.style.background = 'lightgreen';
}
}")
})
setHot5 = function(x) values[["hot5"]] = x
output$hot5 = renderRHandsontable({
bsv_parameters <- values[["hot4"]]
if (!is.null(input$hot5)) {
MAT = hot_to_r(input$hot5)
update <- FALSE
if(length(MAT)!=length(bsv_parameters)){
update <- TRUE
} else {
if(any(dimnames(MAT)[[1]]!=dimnames(bsv_parameters)[[1]])) update <- TRUE
}
if(update){
MAT1 <- bsv_parameters*FALSE
MAT1[bsv_parameters==0] <- TRUE
MAT1 <- as.data.frame(MAT1)
MAT1 <- sapply(MAT1,as.logical)
MAT1[upper.tri(MAT1)] <- NA
MAT1 <- data.frame(MAT1,stringsAsFactors = FALSE)
rownames(MAT1) <- names(MAT1)
new_names <- dimnames(MAT1)[[1]]
old_names <- dimnames(MAT)[[1]]
still_here_old_names <- old_names[old_names %in% new_names]
MAT1[still_here_old_names,still_here_old_names] <- MAT[still_here_old_names,still_here_old_names]
MAT <- MAT1
}
} else {
#par_names <- values[["hot2"]] %>% dplyr::filter(bsv_model!="None") %>% dplyr::select(name)
MAT <- bsv_parameters*FALSE
MAT[bsv_parameters==0] <- TRUE
MAT <- as.data.frame(MAT)
MAT <- sapply(MAT,as.logical)
MAT[upper.tri(MAT)] <- NA
MAT <- data.frame(MAT,stringsAsFactors = FALSE)
rownames(MAT) <- names(MAT)
}
setHot5(MAT)
rhandsontable(MAT) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, overflow="visible") %>%
hot_cols(renderer = "
function (instance, td, row, col, prop, value, cellProperties) {
Handsontable.renderers.CheckboxRenderer.apply(this, arguments);
if (col > row) {
td.style.background = 'grey';
td.style.color = 'grey';
cellProperties.readOnly = true;
}
}")
})
setHot6 = function(x) values[["hot6"]] = x
output$hot6 = renderRHandsontable({
par_names <- c()
if(input$pk_mod){
if (input$ruv_pk_model=="feps.add.prop") par_names <- c(par_names,"PK_prop","PK_add")
if (input$ruv_pk_model=="feps.prop") par_names <- c(par_names,"PK_prop")
if (input$ruv_pk_model=="feps.add") par_names <- c(par_names,"PK_add")
}
if(input$pd_mod){
if (input$ruv_pd_model=="feps.add.prop") par_names <- c(par_names,"PD_prop","PD_add")
if (input$ruv_pd_model=="feps.prop") par_names <- c(par_names,"PD_prop")
if (input$ruv_pd_model=="feps.add") par_names <- c(par_names,"PD_add")
}
if (!is.null(input$hot6)) {
MAT = hot_to_r(input$hot6)
update <- FALSE
if(length(dimnames(MAT)[[1]])!=length(par_names)){
update <- TRUE
} else {
if(any(dimnames(MAT)[[1]]!=par_names)) update <- TRUE
}
if(update){
MAT1 <- zeros(length(par_names))
diag(MAT1) <- 0.01
dimnames(MAT1) <- c(list(par_names),list(par_names))
old_names <- dimnames(MAT)[[1]]
still_here_old_names <- old_names[old_names %in% par_names]
MAT1[still_here_old_names,still_here_old_names] <- MAT[still_here_old_names,still_here_old_names]
MAT <- MAT1
}
} else {
#par_names <- values[["hot2"]] %>% dplyr::filter(bsv_model!="None") %>% dplyr::select(name)
MAT <- zeros(length(par_names))
diag(MAT) <- 0.01
dimnames(MAT) <- c(list(par_names),list(par_names))
}
#row_header_width <- max(nchar(row.names(MAT)))*10
setHot6(MAT)
rhandsontable(MAT) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, overflow="visible",stretchH = "right",
rowHeaderWidth=max(nchar(row.names(MAT)))*10) %>%
hot_cols(renderer = "
function (instance, td, row, col, prop, value, cellProperties) {
Handsontable.renderers.TextRenderer.apply(this, arguments);
if (row == col) {
td.style.background = 'lightgrey';
} else if (col > row) {
td.style.background = 'grey';
td.style.color = 'grey';
} else if (value != 0) {
td.style.background = 'lightgreen';
} else if (value > 0.75) {
td.style.background = 'lightgreen';
}
}")
})
setHot7 = function(x) values[["hot7"]] = x
output$hot7 = renderRHandsontable({
bsv_parameters <- values[["hot6"]]
if (!is.null(input$hot7)) {
MAT = hot_to_r(input$hot7)
update <- FALSE
if(length(MAT)!=length(bsv_parameters)){
update <- TRUE
} else {
if(any(dimnames(MAT)[[1]]!=dimnames(bsv_parameters)[[1]])) update <- TRUE
}
if(update){
MAT1 <- bsv_parameters*FALSE
MAT1[bsv_parameters==0] <- TRUE
MAT1 <- as.data.frame(MAT1)
MAT1 <- sapply(MAT1,as.logical)
MAT1[upper.tri(MAT1)] <- NA
MAT1 <- data.frame(MAT1,stringsAsFactors = FALSE)
rownames(MAT1) <- names(MAT1)
new_names <- dimnames(MAT1)[[1]]
old_names <- dimnames(MAT)[[1]]
still_here_old_names <- old_names[old_names %in% new_names]
MAT1[still_here_old_names,still_here_old_names] <- MAT[still_here_old_names,still_here_old_names]
MAT <- MAT1
}
} else {
#par_names <- values[["hot2"]] %>% dplyr::filter(bsv_model!="None") %>% dplyr::select(name)
MAT <- bsv_parameters*FALSE
MAT[bsv_parameters==0] <- TRUE
MAT <- as.data.frame(MAT)
MAT <- sapply(MAT,as.logical)
MAT[upper.tri(MAT)] <- NA
MAT <- data.frame(MAT,stringsAsFactors = FALSE)
names(MAT) <- colnames(bsv_parameters)
rownames(MAT) <- names(MAT)
}
setHot7(MAT)
rhandsontable(MAT) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, overflow="visible",
rowHeaderWidth=max(nchar(row.names(MAT)))*10) %>%
hot_cols(renderer = "
function (instance, td, row, col, prop, value, cellProperties) {
Handsontable.renderers.CheckboxRenderer.apply(this, arguments);
if (col > row) {
td.style.background = 'grey';
td.style.color = 'grey';
cellProperties.readOnly = true;
}
}")
})
# Compute the forumla text in a reactive expression since it is
# shared by the output$caption and output$mpgPlot expressions
updateDesign <- reactive({
xt <- list()
groupsize <- c()
DF <- data()
cov_names <- DF[DF["covariate"]==T,"name"]
a <- list()
if(length(cov_names)==0) a <- NULL
num_groups <- input$num_groups
for(i in 1:num_groups){
xt_txt <- input[[paste0("xt_",i)]]
xt <- c(xt,list(eval(parse(text=paste("c(",xt_txt,")")))))
groupsize_txt <- input[[paste0("groupsize_",i)]]
groupsize <- c(groupsize,eval(parse(text=groupsize_txt)))
# find covariates
if(length(cov_names)!=0){
cov_vals <- c()
for(j in cov_names){
a_txt <- input[[paste0(j,"_",i)]]
cov_vals <- c(cov_vals,eval(parse(text=paste0(j,"=",a_txt))))
}
a <- c(a,cov_vals)
}
}
return(list(xt=xt,a=a,groupsize=groupsize))
})
get_dose_type <- reactive({
dose_type <- input$dose_type
return(dose_type)
})
output$hot_dose_table = renderRHandsontable({
DF <- NULL
if (!is.null(input$hot_dose_table)) {
DF = hot_to_r(input$hot_dose_table)
values[["hot_dose_table"]] = DF
} else if (!is.null(values[["hot_dose_table"]])) {
DF = values[["hot_dose_table"]]
}
if(!is.null(DF)){
rhandsontable(DF,
highlightCol = TRUE,
highlightRow = TRUE)
}
})
get_mod_type <- reactive({
mod_type <- c()
if(input$pk_mod) mod_type <- c(mod_type,"PK")
if(input$pd_mod) mod_type <- c(mod_type,"PD")
mod_type
})
hot_sample_table_data = reactive({
mod_type <- get_mod_type()
if (!is.null(input$hot_sample_table)) {
DF = hot_to_r(input$hot_sample_table)
} else {
DF = data.frame(groups = c(""),
times = c(""),
stringsAsFactors = FALSE)
if(length(mod_type)>1)
DF$type <- factor(c(mod_type[1]),levels=c(mod_type))
}
if(length(mod_type)>1 && all(is.null(DF$type)))
DF$type <- factor("",levels=c(mod_type))
DF
})
output$hot_sample_table = renderRHandsontable({
DF <- hot_sample_table_data()
if(!is.null(DF)){
rhandsontable(DF,overflow="visible")
}
})
# output$table_tmp <- renderTable(DF <- hot_sample_table_data())
output$group_designs <- renderUI({
out <- list()
num_groups <- input$num_groups
DF <- data()
#if(any(DF$covariate))
for(i in 1:num_groups){
out <- c(out,list(h3(paste0("Group ", i))))
out <- c(out,list(textInput(paste0("groupsize_",i),
paste0("Number of individuals in group ",i,":"), "" )))
if(input$struct_PK_model!="NULL"){
out <- c(out,list(
#wellPanel(
h3(paste0("Regimen")),
textInput(paste0("amt_",i),
paste0("Dose amount(s):")),
textInput(paste0("d_time_",i),
paste0("Dose time(s):"),
value="0"),
selectInput(paste0("dose_type_",i), "Dose type",
list(
"Bolus" = "bolus",
"Infusion" = "infusion"
))
#)
# conditionalPanel(
# condition = "input.dose_type == 'infusion'",
# sliderInput("breakCount", "Break Count", min=1, max=1000, value=10)
# )
))
#if(!is.null(input$dose_type)){
out <- c(out,list(
conditionalPanel(
condition = paste0("input.dose_type_",i," == 'infusion'"),
textInput(paste0("inf_dur_",i),
paste0("Infusion duration(s):"),
value="")
)))
# if(input$dose_type=="bolus") textInput(paste0("amt33_",i),paste0("dooo amount"))
#}
#if(get_dose_type()=="bolus") out <- c(out,list(h3(paste0("Group ", i))))
}
if(input$struct_PK_model!="NULL"){
out <- c(out,list(textInput(paste0("xt_pk_",i), paste0("PK Sample times:"))))
}
if(input$struct_PD_model!="NULL"){
out <- c(out,list(textInput(paste0("xt_pd_",i), paste0("PD Sample times:"))))
}
if(any(DF$covariate)){
cov_names <- DF[DF["covariate"]==T,"name"]
names_par <- cov_names[!cov_names %in% c("Dose","DOSE","dose","tau","TAU","Tau")]
for(j in names_par){
out <- c(out,list(textInput(paste0(j,"_",i),paste0(j,":"))))
}
}
# if(num_groups > 1){
# out <- c(out,list(actionButton(paste0("remove_group_",i),paste0("Remove Group ",i))))
# #out <- c(out,list(renderPrint({ input[[paste0("remove_group_",i)]] })))
# }
}
#out <- c(out,list(renderPrint({ input$new_group })))
#out <- c(out,list(actionButton("new_group","Add a new group")))
return(as.list(out))
})
# result <- list()
# for(i in 1:input$num_groups){
# test <- renderUI({
# out <- list()
# if(input$dose_type=="bolus") out <- c(out,list(h3(paste0("Group "))))
# return(as.list(out))
# })
#
# test2 <- renderUI({
# out <- list()
# if(input$dose_type=="bolus") out <- c(out,list(h3(paste0("Group "))))
# return(as.list(out))
# })
# result <- c(result, test,test2)
# }
# output$test <- result
#
output$parameter_vales <- renderUI({
out <- list()
parameter_names <- codetools::findGlobals(eval(parse(text="ff.PK.1.comp.oral.sd.CL")),merge=F)$variables
df <- data.frame(par_names=parameter_names)
df$covariate <- df$par_names %in% c("Dose","DOSE","dose","tau","TAU","Tau")
out <- c(out,list(fluidRow(
column(3, wellPanel(
h3("Prameter")
)),
column(3, wellPanel(
h3("Fixed effect value")
# This outputs the dynamic UI component
#uiOutput("ui")
)),
column(3, wellPanel(
h3("Random effect value")
)
))))
for(i in 1:length(df$par_names)){
if(!df$covariate[i]){
out <- c(out,list(fluidRow(
column(3, wellPanel(
h3(df$par_names[i])
)),
column(3, wellPanel(
textInput(df$par_names[i],NULL)
# This outputs the dynamic UI component
#uiOutput("ui")
)),
column(3, wellPanel(
textInput(df$par_names[i],NULL)
)
))))
#out <- c(out,list(h3(df$par_names[i])))
#out <- c(out,list(textInput(df$par_names[i],"Fixed effect value")))
#out <- c(out,list(textInput(df$par_names[i],"Random effect value")))
# out <- c(out,list(selectInput("struct_PK_model", "Structural PK Model:",
# list(
# "1-cpt, 1st order abs., single dose, CL param." = "ff.PK.1.comp.oral.sd.CL",
# "1-cpt, 1st order abs., single dose, KE param." = "ff.PK.1.comp.oral.sd.KE",
# "1-cpt, 1st order abs., multi. dose, CL param." = "ff.PK.1.comp.oral.md.CL",
# "1-cpt, 1st order abs., multi. dose, KE param" = "ff.PK.1.comp.oral.md.KE"
# ))))
}
}
return(as.list(out))
})
number_of_groups <- reactive({
max_groups <- input$new_group + 1
num_groups <- max_groups
cat("\n\n NEW search:\n")
for(i in 1:max_groups){
if(length(input[[paste0("remove_group_",i)]])!=0) {
cat("remove_group",i, input[[paste0("remove_group_",i)]], "\n")
num_groups <- num_groups - input[[paste0("remove_group_",i)]]
}
}
return(num_groups)
})
updateModel <- reactive({
struct_pk_model <- input$struct_pk_model
struct_pd_model <- input$struct_pd_model
link_model <- input$link_fcn
ruv_pk_model <- input$ruv_pk_model
ruv_pd_model <- input$ruv_pd_model
bsv_pk_model <- input$bsv_pk_model
bsv_pd_model <- input$bsv_pd_model
sfg <- build_sfg(model=input$struct_pk_model,etas=input$bsv_pk_model)
#environment(eval(parse(text=input$struct_model)))
#parent.env(environment())
#browser()
nbpop <- find.largest.index(func.str=sfg,lab="bpop")
#bpop_vals=c(CL=0.15, V=8, KA=1.0, Favail=1)
#bpop_vals=c(CL=1, V=1, KA=1, Favail=1)
#bpop_vals <- rep(1,nbpop)
nb <- find.largest.index(func.str=sfg,lab="b")
if(input$struct_model=="ff.PK.1.comp.oral.sd.CL"){
bpop_vals=c(CL=0.15, V=8, KA=1.0, Favail=1)
notfixed_bpop=c(1,1,1,0)
d_vals=c(CL=0.07, V=0.02, KA=0.6)
sigma_vals=c(0.1,0.1)
groupsize=32
#xt=c( 0.5,1,2,6,24,36,72,120),
minxt=0
maxxt=120
a=70
}
return(list(bpop=bpop_vals,d=d_vals,sigma=sigma_vals,
notfixed_bpop=notfixed_bpop,
sfg=sfg))
})
create_sfg <- reactive({
eta_df <- values[["hot2"]]
eta_nl <- eta_df$bsv_model
names(eta_nl) <- eta_df$name
eta_nl <- dplyr::recode(eta_nl,"Exponential"="exp","Proportional"="prop","Additive"="add","None"="none")
build_sfg(model=model_name(),etas=levels(eta_nl)[eta_nl])
})
create_db <- reactive({
#model <- updateModel()
#design <- updateDesign()
# df <- data()
# df_2 <- df[df$covariate==F,]
# bpop <- df_2[["pop_val"]]
# names(bpop) <- df_2[["name"]]
# bpop_notfixed <- !df_2[["pop_fixed"]]
# names(bpop_notfixed) <- df_2[["name"]]
# par_names <- df_2[["name"]]
create_model <-
function(struct_mod,
param_mod,
error_mod){
model <- list(
ff_fun=struct_mod,
fError_fun=error_mod,
fg_fun=param_mod
)
}
model_def <- create_model(model_name(),create_sfg(),input$ruv_pk_model)
# parameters
bpop_df <- values[["hot3"]]
bpop <- bpop_df$value
names(bpop) <- bpop_df$name
notfixed_bpop <- !(bpop_df$fixed)
names(notfixed_bpop) <- bpop_df$name
omega_mat <- values[["hot4"]]
is_diagonal_omega <- all(diag(diag(omega_mat))==omega_mat)
d_vec <- diag(omega_mat)
covd <- NULL
if(!is_diagonal_omega) covd <- omega_mat[lower.tri(omega_mat)]
omega_mat_fixed <- as.matrix(values[["hot5"]])
notfixed_d <- !diag(omega_mat_fixed)
notfixed_covd <- NULL
if(!is_diagonal_omega) notfixed_covd <- !(omega_mat_fixed[lower.tri(omega_mat_fixed)])
sigma_mat <- values[["hot6"]]
# is_diagonal_sigma <- all(diag(diag(sigma_mat))==sigma_mat)
# sigma_vec <- diag(sigma_mat)
# covsigma <- NULL
# if(!is_diagonal_sigma) covsigma <- sigma_mat[lower.tri(sigma_mat)]
sigma_mat_fixed <- as.matrix(values[["hot7"]])
notfixed_sigma <- !diag(sigma_mat_fixed)
# notfixed_covsigma <- NULL
# if(!is_diagonal_sigma) notfixed_covsigma <- !(sigma_mat_fixed[lower.tri(sigma_mat_fixed)])
hot_sample_table_data()
par_def <- list(
bpop = bpop,
notfixed_bpop=notfixed_bpop,
d=d_vec,
notfixed_d = notfixed_d,
covd = covd,
notfixed_covd=notfixed_covd,
sigma = sigma_mat,
notfixed_sigma = notfixed_sigma#,
# covsigma = covsigma,
# notfixed_covsigma = notfixed_covsigma
)
## -- Define initial design and design space
#design <- updateDesign()
do.call(create.poped.database,
c(model_def,
par_def,
list(groupsize=20,
xt=c(0.5,1,2,6,24),
#xt=c(1,2,3,15),
#xt=eval(parse(text=paste("c(",input$xt,")"))),
#xt=design$xt[[1]],
minxt = 0,
maxxt = 24,
a=list(c(DOSE=100))
)))
})
# Return the formula text for printing as a caption
#output$caption <- renderText({
# "Model predictions"
#})
#get_parameters <-
#codetools::findGlobals(ff.PK.1.comp.oral.sd.CL,merge=F)
# Generate a plot of the requested variable against mpg and only
# include outliers if requested
output$modelPlot <- renderPlot({
poped_db <- create_db()
#plot_model_prediction(poped.db)
#print(plot_model_prediction(poped.db))
plot_model_prediction(poped_db,IPRED=input$IPRED,DV=input$DV,separate.groups=input$separate.groups)
#print(plot_model_prediction(poped.db.1,IPRED=input$IPRED,DV=input$DV,separate.groups=input$separate.groups))
#print(plot_model_prediction(poped.db.2,IPRED=TRUE,DV=TRUE))
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.