app.R
In htx-r/doseresNMA:
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(devtools)
library(R2jags)
library(rms)
library(meta)
library(tibble) # for convTab
library('MBNMAdose')
# install_github("audrey-b/BUGSnet",force = TRUE)
# library(BUGSnet)
# install_github("htx-r/doseresNMA",force=TRUE)
# library(doseresNMA)
source('FunctionsTOplot.R')
source('FunctionsTOrun.R')
source('cleanAntidepData.R')
source('FunctionsTOcleandata.R')
source('BUGSnetFunctions.R')
library(dplyr)
#******* DATA
# default data
mydata <- read.csv('DOSEmainanalysis.csv')
antidepdata=mydata#[mydata$exc==F,]
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
navbarPage("DosResNMA",
tabPanel("Get started",
h3('DosResNMA V1.1'),
h5('Please click the button below to download a copy of the DosResNMA User Guide')),
tabPanel("Load Data", sidebarPanel(
h3('Select a data file (.csv)'),
h5('Note: Excel files should be saved in csv (Comma delimited) (*.csv) format. Default maximum file size is 5MB.'),
fileInput("file", "File input:"),
# selectInput('selectFormat',label = h3('2. Wide/Long data format'),choices = c('Wide format'=1,'Long format'=2),selected = 1),
h3('Set the variable names'),
uiOutput( 'studyid'),
uiOutput( 'drug'),
uiOutput( 'dose'),
uiOutput( 'r'),
uiOutput( 'n'),
uiOutput('class'),
uiOutput('cov1',value = 'NULL'),
uiOutput('cov2',value = 'NULL'),
uiOutput('cov3',value = 'NULL'),
selectInput("dosetype", "The doses are", c('drug-specific','harmonized'), selected = 'drug-specific'),
width = 4
),
mainPanel(
tabsetPanel(
# tabPanel("Format data ", h3('Generic Instructions'),h4('The data need to be in a wide format, if not, it will be transferred from a long to wide format.')
# #h4('1. Start with load the data file (the file should be *.csv format)'),h4('2. Set the names of the following variables: '), h5('a. The study id; studyid'),h5('b. The drug name; drug'),h5('c. The dose level; dose'),h5('d. The number of events; r'),h5('e. The sample size; n'), h5('f. The class of the drug; class (optional)',h5('j. The covariate of interest; covariate (optional - is needed for meta-regression)')
# ),
tabPanel("Original data", DT::dataTableOutput('contents')),
tabPanel("Cleaning data", h4('Not available entries (NA) can cause numerical problems in computations. Therefore, a row is deleted when one of the following is not avaliable: '),
h5('1. Response '),h5('2. Sample size '),h5('3. Dose level value'),h5('4. The same dose in some/all arms in a study is reported, for example, if in a study, dose1 = dose2 = 100, both arms will be deleted '),h5('5. Single-arm studies - only a single row for that study is reported')
, hr(), h4('The excluded studies are those with the following IDs:'),textOutput('outStudy')
# verbatimTextOutput("outStudy", placeholder = TRUE)
),
tabPanel("Reformatted data",DT::dataTableOutput('newDF'),br(),h3('Download the data that will be used in the analysis'),downloadButton('downloadData','Download'),hr()
,h4('Note: The data should be uploaded in a long format'))
)
)),
tabPanel("Explore Data",
mainPanel(
tabsetPanel(
# tabPanel("Forest plot"),
tabPanel('Network characteristics',h3('Network Characteristics'),br(),tableOutput('tab1'),h3('Intervention Characteristics'),br(),tableOutput('tab2'),h3('Comparison Characteristics'),br(),tableOutput('tab3')
,br(),br(),hr(),h4('Download the three tables here'),downloadButton("downloadTable1", "Download Tab1"),downloadButton("downloadTable2", "Download Tab2"),downloadButton("downloadTable3", "Download Tab3"),br(),hr()
),
tabPanel("Network diagram" ,sidebarPanel(sliderInput('node','Node scale',1,3,value=1.2,step=0.2),sliderInput('edge','Edge scale',1,3,value=1.25,step = 0.2),sliderInput('label','Label distance',1,4,value=1.25,step = 0.2)
,textInput('v.color','Node color',value = '#96B1D0'),textInput('e.color','Edge color',value = '#AC99C1'),checkboxInput('removeLoops','Remove loops',value = TRUE)),
mainPanel(#plotOutput('netplot'),br(),hr(),h4('Download the network diagram'),downloadButton("downloadNetPlot", "Download"),
h3('Splitted network'),plotOutput('netplot2'),hr(),h3('Lumped network'),plotOutput('netplot3'),hr(),h3('Lumped network with colored dose-response connection'),plotOutput('netplot4')
)
)
)
)),
tabPanel("Data analysis", #sidebarPanel(
#h4('Please select the covariates that you want to add to the model'),
#checkboxInput('showModel1','Show/Hide Model 1', value = TRUE)
#),
mainPanel(
tabsetPanel(
tabPanel(
'Model specification',textOutput('sumup'),h3('JAGS model specifications'),
numericInput('n.iter','Number of itererations',value = 1000),
numericInput('n.burnin','Number of burn-in',value = 200),
numericInput('n.thin','Number of thinning',value = 1),
numericInput('n.chain','Number of chains',value = 3),
selectInput('addclass','Add class effect', c('Yes', 'No'), 'No'),
selectInput('addcov','Add covariate', c('No', 'Covariate 1', 'Covariate 2', 'Covariate 3'), 'No')
)
,
tabPanel("Summary of results",h3('Dose-response coefficients'),plotOutput('forestplot')#tabsetPanel( # league table and forest plot for each # , h3('JAGS model output'),verbatimTextOutput("jagsmodel"),hr()
#
# tabPanel('Lumped DR-NMA',h3('JAGS model output'),verbatimTextOutput("jagsmodel"),hr(),h3('Forest Plot'),plotOutput('forestplot'))
# )
,hr(), h3('The common heterogeneity estimate'), textOutput('tau'),textOutput('ci')),
tabPanel("Assess model fit",plotOutput('fitplot')), # fitted curves for each drug + deviance?
tabPanel("Prediction",h3('Absolute effect curve'),plotOutput('absoluteplot'),hr(),h3('Ranking plot'),conditionalPanel(condition = "input.dosetype=='harmonized'",plotOutput('sucraPlot'))),#,plotOutput('sucraPlot'),h4("The Sucra plot can't be provided since the doses are not harmonized"))), # Absoulte effect curve for each drug
tabPanel("Consistency",h3('Consistency-Inconsistency agreement plot'),h4('Linear coefficient: beta1'),plotOutput('ConIncon1'),h4('Spline coefficient: beta2'),plotOutput('ConIncon2')),
tabPanel("Convergence",h3('Convergence assessment table'),tableOutput('convTab'),hr(),h3('Histogram of the intervention-specific beta1'),plotOutput('hist1'),h3('Histogram of the intervention-specific beta2'),plotOutput('hist2'))
)
))
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# 1. Load data
# output$sumup <- renderText({
# paste0('The analysis will be conducted for a model ', ifelse("input.addclass=='No'",'without','with'),' a class effect')
# })
# 1.1 View data
myData <- reactive({
inFile <- input$file
if (is.null(inFile)) return(antidepdata)
data <- read.csv(inFile$datapath, header = TRUE)
data
})
output$contents <- DT::renderDataTable({
DT::datatable(myData())
})
# 1.2 Clean data
# select columns
var1 <- renderText({input$var1})
var2 <- renderText({input$var2})
var3 <- renderText({input$var3})
var4 <- renderText({input$var4})
var5 <- renderText({input$var5})
# if (class==TRUE) {
# varnames <- append(varnames, "class")
# }
# var6 <- renderText({input$var6})
# var7 <- renderText({input$var7})
output$studyid <- renderUI({
selectInput("var1", "Study ID", colnames(myData()), selected = ifelse(is.null(input$file),'Study_No',NULL)) # colnames(as.data.frame(myData()))
})
output$drug <- renderUI({
selectInput("var2", "Intervention", colnames(myData()), selected = ifelse(is.null(input$file),'Drug',NULL)) # colnames(as.data.frame(myData()))
})
output$dose <- renderUI({
selectInput("var3", "Dose", colnames(myData()), selected = ifelse(is.null(input$file),'Dose_delivered_mean',NULL)) # colnames(as.data.frame(myData()))
})
output$r <- renderUI({
selectInput("var4", "Events", colnames(myData()), selected = ifelse(is.null(input$file),'Responders',NULL)) # colnames(as.data.frame(myData()))
})
output$n <- renderUI({
selectInput("var5", "Sample size", colnames(myData()), selected = ifelse(is.null(input$file),'No_randomised',NULL)) # colnames(as.data.frame(myData()))
})
output$class <- renderUI({
selectInput("var6", "Class", c(NA,colnames(myData()))) # colnames(as.data.frame(myData()))
})
output$cov1 <- renderUI({
selectInput("var7", "Covariate 1", c(NA,colnames(myData()))) # colnames(as.data.frame(myData()))
})
output$cov2 <- renderUI({
selectInput("var7", "Covariate 2", c(NA,colnames(myData()))) # colnames(as.data.frame(myData()))
})
output$cov3 <- renderUI({
selectInput("var7", "Covariate 3", c(NA,colnames(myData()))) # colnames(as.data.frame(myData()))
})
# output$dosetype <- renderUI({
# selectInput("dosetype", "The doses are", c('drug-specific','harmonized'), selected = 'drug-specific') # colnames(as.data.frame(myData()))
# })
# change column names
renameData <- reactive({
newDF1 <- subset(myData(),select=c(var1(),var2(),var3(),var4(),var5())) # ,var6(),var7()
names(newDF1) <- c('studyid','drug','dose','r','n') # ,'class','covariate'
# if (var6()!='NULL') {
# names(newDF1) <- append(varnames, "class")
# }
# if (var7()!='NULL' | var8()!='NULL' | var9()!='NULL' ) {
# names(newDF1) <- append(varnames, "covariate")
# }
newDF1
})
# remove NA's
cleanData <- reactive({
newDF2 <- removeNAdosresdata.fun(renameData())$dataset
newDF2 <- newDF2[newDF2$exclude==FALSE,]
newDF2
})
# exculded studies
output$outStudy <- renderText({
excStudy <- removeNAdosresdata.fun(renameData())$out # use the cleaned data to all outputs below
rbind(excStudy)
})
# 1.3 Reformat data
output$newDF <- DT::renderDataTable({
DT::datatable(cleanData())
})
#** Explore data
# network diagram
output$netplot <- renderPlot({
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net.plot(myd,node.scale = input$node,edge.scale = input$edge) # 0.2 0.25
})
# another network diagrams using MBNMAdose package
output$netplot2 <- renderPlot({
antidepdataN <- data.frame(studyID=as.numeric(as.factor(cleanData()$studyid)),agent=cleanData()$drug,dose=cleanData()$dose,
r=cleanData()$r,N=cleanData()$n)
datatnet <- mbnma.network(antidepdataN)
plot(datatnet,level='treatment',v.scale = input$node,edge.scale = input$edge,label.distance=input$label,
vertex.color=input$v.color,edge.color=input$e.color,remove.loops=input$removeLoops)
})
output$netplot3 <- renderPlot({
antidepdataN <- data.frame(studyID=as.numeric(as.factor(cleanData()$studyid)),agent=cleanData()$drug,dose=cleanData()$dose,
r=cleanData()$r,N=cleanData()$n)
datatnet <- mbnma.network(antidepdataN)
plot(datatnet,level='agent',v.scale = input$node,edge.scale = input$edge,label.distance=input$label,vertex.color=input$v.color,edge.color=input$e.color,remove.loops=input$removeLoops)
})
output$netplot4 <- renderPlot({
antidepdataN <- data.frame(studyID=as.numeric(as.factor(cleanData()$studyid)),agent=cleanData()$drug,dose=cleanData()$dose,
r=cleanData()$r,N=cleanData()$n)
datatnet <- mbnma.network(antidepdataN)
plot(datatnet,level='agent',doselink=2,v.scale = input$node,edge.scale = input$edge, label.distance=input$label,vertex.color=input$v.color,edge.color=input$e.color,remove.loops=input$removeLoops)
})
# table of network characteristics
output$tab1 <- renderTable({
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$network
})
# table of intervention characteristics
output$tab2 <- renderTable({
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$intervention[,c('drug','n.studies','n.events','n.patients')]
})
# table of comparison characteristics
output$tab3 <- renderTable({
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$comparison[,c('comparison','n.studies','n.patients')]
})
# Explore Data
# download files
output$downloadData <- downloadHandler(
filename = function() {
paste('data-', Sys.Date(), '.csv', sep='')
},
content = function(con) {
write.csv(cleanData(), con)
}
)
output$downloadTable3 <- downloadHandler(
filename = function() {
paste('ComparisonCharTable-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net_tab <- net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$comparison
write.table(net_tab,file,sep = ',')
}
)
output$downloadTable2 <- downloadHandler(
filename = function() {
paste('InterventionCharTable-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net_tab <- net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$intervention
write.table(net_tab,file,sep = ',')
}
)
output$downloadTable1 <- downloadHandler(
filename = function() {
paste('NetworkCharTable-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net_tab <- net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$network
write.table(net_tab,file,sep = ',')
}
)
output$downloadNetPlot <- downloadHandler( # does not execute
filename = function() {
paste('NetPlot', Sys.Date(), '.pdf', sep='')
},
content = function(file) {
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
pp <- net.plot(myd,node.scale = input$node,edge.scale = input$edge) # 0.2 0.23
# device <- function(..., width, height) {
# grDevices::png(..., width = width, height = height,
# res = 300, units = "in")
# }
# ggsave(file,pp,device = device)
pdf(file)
print(pp)
}
)
# n.chain <- reactive({input$n.chain})
# n.iter <- reactive({input$n.iter})
# n.burnin <- reactive({input$n.burnin})
# n.thin <- reactive({input$n.thin})
# Data analysis
fitjagsmodel <- reactive({
dosresnetmeta.jagsdata <- makeJAGSdata(data=cleanData(),metareg=F,class.effect=F,ref.lab='placebo',refclass.lab = 'placebo')
jagsmodelDRnetmeta<- makeJAGSmodel(metareg=F,effects='random',consistency=T,class.effect=F,doselink='spline')
dosresnetmeta.runjagsRCS <- jags.parallel(data = dosresnetmeta.jagsdata,inits=NULL,parameters.to.save = c('beta1','beta2','bb1','bb2','gamma','b1','b2','tau','Z','p.drug','dev','rhat','r','n','totresdev'),model.file = jagsmodelDRnetmeta,
n.chains=3,n.iter = 1000,n.burnin = 200,DIC=F,n.thin = 1)
dosresnetmeta.runjagsRCS
})
fitjagsmodelInc <- reactive({
dosresnetmeta.jagsdata <- makeJAGSdata(data=cleanData(),metareg=F,class.effect=F,ref.lab='placebo',refclass.lab = 'placebo')
jagsmodelDRnetmeta<- makeJAGSmodel(metareg=F,effects='random',consistency=F,class.effect=F,doselink='spline')
dosresnetmeta.runjagsRCSInc <- jags.parallel(data = dosresnetmeta.jagsdata,inits=NULL,parameters.to.save = c('beta1','beta2','bb1','bb2','gamma','b1','b2','tau','Z','p.drug'),model.file = jagsmodelDRnetmeta,
n.chains=3,n.iter = 1000,n.burnin = 200,DIC=F,n.thin = 1)
dosresnetmeta.runjagsRCSInc
})
# Forest plot
output$forestplot <- renderPlot({
x <- fitjagsmodel()
drug.lab <- levels(cleanData()$drug)
forestplot(x=x,drug.lab = drug.lab)
})
output$tau <- renderText({
paste0("\t",'Mean of ', 'tau',': ',round(fitjagsmodel()$BUGSoutput$summary['tau','mean'],3))
})
output$ci <- renderText({
paste0(' Credible Interval (CI): [', round(fitjagsmodel()$BUGSoutput$summary['tau','2.5%'],3),', ',
round(fitjagsmodel()$BUGSoutput$summary['tau','97.5%'],3), ']')
})
# Predicted absolute response plot
output$absoluteplot <- renderPlot({
x <- fitjagsmodel()
drug.lab <- levels(cleanData()$drug)
ref.lab <- 'placebo'
absolutePredplot(x=x,ref.lab='placebo',refclass.lab='placebo',drug.lab=drug.lab, class.lab=NULL,class.effect=F)
})
output$convTab <- renderTable({
x <- fitjagsmodel()
drug.lab <- levels(cleanData()$drug)
converge.table(x=x,ref.lab='placebo',refclass.lab='placebo',drug.lab=drug.lab, class.lab=NULL,class.effect=F)
})
output$hist1 <- renderPlot({
x <- fitjagsmodel()
histDRparam(x=x,metareg=F,class.effect=F)
})
output$hist2 <- renderPlot({
x <- fitjagsmodel()
drug.labs <- levels(cleanData()$drug)
ndrugs <- length(drug.labs)
param.labs <- c(paste0('d[',(1:ndrugs)[-ref],']'),paste0('d2[',(1:ndrugs)[-ref],']'))
len <- prod(dim(x$BUGSoutput$sims.array[,,'d[1]']))
plotdata <- data.frame(sim=c(x$BUGSoutput$sims.array[,,param.labs]),param=rep(param.labs,each=len))
plotdata2 <- plotdata[plotdata$param%in%param.labs[(ndrugs):(2*ndrugs-2)],]
g <- ggplot(plotdata2, aes(x=sim)) +
geom_histogram(alpha=0.6, binwidth = 0.002,color="darkblue", fill="lightblue")
g <- g + ggplot2::facet_wrap(~plotdata2$param,scales = 'free')
g <- g + ggplot2::labs(y="Frequency", x="iterations")
g
})
output$sucraPlot <- renderPlot({
x <- fitjagsmodel()
drug.lab <- levels(cleanData()$drug)
sucraPlot(x=x,ref.lab='placebo',refclass.lab='placebo',drug.lab=drug.lab, class.lab=NULL,class.effect=F)
})
# consistency-inconsistency agreement plot
output$ConIncon1 <- renderPlot({
cons.model <- fitjagsmodel()
incons.model <- fitjagsmodelInc()
comp <- direct.comp.index(cleanData())
direct.lab <- paste0('bb1[',comp[,'t1'],',',comp[,'t2'],']')
cons.icons.Plot(cons.model, incons.model,direct.lab)
})
output$ConIncon2 <- renderPlot({
cons.model <- fitjagsmodel()
incons.model <- fitjagsmodelInc()
comp <- direct.comp.index(cleanData())
direct.lab <- paste0('bb2[',comp[,'t1'],',',comp[,'t2'],']')
cons.icons.Plot(cons.model, incons.model,direct.lab)
})
output$fitplot <- renderPlot({
x <- fitjagsmodel()
fitplot(x)
})
}
# Run the application
shinyApp(ui = ui, server = server)
htx-r/doseresNMA documentation built on Jan. 28, 2021, 5:32 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(devtools)
library(R2jags)
library(rms)
library(meta)
library(tibble) # for convTab
library('MBNMAdose')
# install_github("audrey-b/BUGSnet",force = TRUE)
# library(BUGSnet)
# install_github("htx-r/doseresNMA",force=TRUE)
# library(doseresNMA)
source('FunctionsTOplot.R')
source('FunctionsTOrun.R')
source('cleanAntidepData.R')
source('FunctionsTOcleandata.R')
source('BUGSnetFunctions.R')
library(dplyr)
#******* DATA
# default data
mydata <- read.csv('DOSEmainanalysis.csv')
antidepdata=mydata#[mydata$exc==F,]
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
navbarPage("DosResNMA",
tabPanel("Get started",
h3('DosResNMA V1.1'),
h5('Please click the button below to download a copy of the DosResNMA User Guide')),
tabPanel("Load Data", sidebarPanel(
h3('Select a data file (.csv)'),
h5('Note: Excel files should be saved in csv (Comma delimited) (*.csv) format. Default maximum file size is 5MB.'),
fileInput("file", "File input:"),
# selectInput('selectFormat',label = h3('2. Wide/Long data format'),choices = c('Wide format'=1,'Long format'=2),selected = 1),
h3('Set the variable names'),
uiOutput( 'studyid'),
uiOutput( 'drug'),
uiOutput( 'dose'),
uiOutput( 'r'),
uiOutput( 'n'),
uiOutput('class'),
uiOutput('cov1',value = 'NULL'),
uiOutput('cov2',value = 'NULL'),
uiOutput('cov3',value = 'NULL'),
selectInput("dosetype", "The doses are", c('drug-specific','harmonized'), selected = 'drug-specific'),
width = 4
),
mainPanel(
tabsetPanel(
# tabPanel("Format data ", h3('Generic Instructions'),h4('The data need to be in a wide format, if not, it will be transferred from a long to wide format.')
# #h4('1. Start with load the data file (the file should be *.csv format)'),h4('2. Set the names of the following variables: '), h5('a. The study id; studyid'),h5('b. The drug name; drug'),h5('c. The dose level; dose'),h5('d. The number of events; r'),h5('e. The sample size; n'), h5('f. The class of the drug; class (optional)',h5('j. The covariate of interest; covariate (optional - is needed for meta-regression)')
# ),
tabPanel("Original data", DT::dataTableOutput('contents')),
tabPanel("Cleaning data", h4('Not available entries (NA) can cause numerical problems in computations. Therefore, a row is deleted when one of the following is not avaliable: '),
h5('1. Response '),h5('2. Sample size '),h5('3. Dose level value'),h5('4. The same dose in some/all arms in a study is reported, for example, if in a study, dose1 = dose2 = 100, both arms will be deleted '),h5('5. Single-arm studies - only a single row for that study is reported')
, hr(), h4('The excluded studies are those with the following IDs:'),textOutput('outStudy')
# verbatimTextOutput("outStudy", placeholder = TRUE)
),
tabPanel("Reformatted data",DT::dataTableOutput('newDF'),br(),h3('Download the data that will be used in the analysis'),downloadButton('downloadData','Download'),hr()
,h4('Note: The data should be uploaded in a long format'))
)
)),
tabPanel("Explore Data",
mainPanel(
tabsetPanel(
# tabPanel("Forest plot"),
tabPanel('Network characteristics',h3('Network Characteristics'),br(),tableOutput('tab1'),h3('Intervention Characteristics'),br(),tableOutput('tab2'),h3('Comparison Characteristics'),br(),tableOutput('tab3')
,br(),br(),hr(),h4('Download the three tables here'),downloadButton("downloadTable1", "Download Tab1"),downloadButton("downloadTable2", "Download Tab2"),downloadButton("downloadTable3", "Download Tab3"),br(),hr()
),
tabPanel("Network diagram" ,sidebarPanel(sliderInput('node','Node scale',1,3,value=1.2,step=0.2),sliderInput('edge','Edge scale',1,3,value=1.25,step = 0.2),sliderInput('label','Label distance',1,4,value=1.25,step = 0.2)
,textInput('v.color','Node color',value = '#96B1D0'),textInput('e.color','Edge color',value = '#AC99C1'),checkboxInput('removeLoops','Remove loops',value = TRUE)),
mainPanel(#plotOutput('netplot'),br(),hr(),h4('Download the network diagram'),downloadButton("downloadNetPlot", "Download"),
h3('Splitted network'),plotOutput('netplot2'),hr(),h3('Lumped network'),plotOutput('netplot3'),hr(),h3('Lumped network with colored dose-response connection'),plotOutput('netplot4')
)
)
)
)),
tabPanel("Data analysis", #sidebarPanel(
#h4('Please select the covariates that you want to add to the model'),
#checkboxInput('showModel1','Show/Hide Model 1', value = TRUE)
#),
mainPanel(
tabsetPanel(
tabPanel(
'Model specification',textOutput('sumup'),h3('JAGS model specifications'),
numericInput('n.iter','Number of itererations',value = 1000),
numericInput('n.burnin','Number of burn-in',value = 200),
numericInput('n.thin','Number of thinning',value = 1),
numericInput('n.chain','Number of chains',value = 3),
selectInput('addclass','Add class effect', c('Yes', 'No'), 'No'),
selectInput('addcov','Add covariate', c('No', 'Covariate 1', 'Covariate 2', 'Covariate 3'), 'No')
)
,
tabPanel("Summary of results",h3('Dose-response coefficients'),plotOutput('forestplot')#tabsetPanel( # league table and forest plot for each # , h3('JAGS model output'),verbatimTextOutput("jagsmodel"),hr()
#
# tabPanel('Lumped DR-NMA',h3('JAGS model output'),verbatimTextOutput("jagsmodel"),hr(),h3('Forest Plot'),plotOutput('forestplot'))
# )
,hr(), h3('The common heterogeneity estimate'), textOutput('tau'),textOutput('ci')),
tabPanel("Assess model fit",plotOutput('fitplot')), # fitted curves for each drug + deviance?
tabPanel("Prediction",h3('Absolute effect curve'),plotOutput('absoluteplot'),hr(),h3('Ranking plot'),conditionalPanel(condition = "input.dosetype=='harmonized'",plotOutput('sucraPlot'))),#,plotOutput('sucraPlot'),h4("The Sucra plot can't be provided since the doses are not harmonized"))), # Absoulte effect curve for each drug
tabPanel("Consistency",h3('Consistency-Inconsistency agreement plot'),h4('Linear coefficient: beta1'),plotOutput('ConIncon1'),h4('Spline coefficient: beta2'),plotOutput('ConIncon2')),
tabPanel("Convergence",h3('Convergence assessment table'),tableOutput('convTab'),hr(),h3('Histogram of the intervention-specific beta1'),plotOutput('hist1'),h3('Histogram of the intervention-specific beta2'),plotOutput('hist2'))
)
))
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# 1. Load data
# output$sumup <- renderText({
# paste0('The analysis will be conducted for a model ', ifelse("input.addclass=='No'",'without','with'),' a class effect')
# })
# 1.1 View data
myData <- reactive({
inFile <- input$file
if (is.null(inFile)) return(antidepdata)
data <- read.csv(inFile$datapath, header = TRUE)
data
})
output$contents <- DT::renderDataTable({
DT::datatable(myData())
})
# 1.2 Clean data
# select columns
var1 <- renderText({input$var1})
var2 <- renderText({input$var2})
var3 <- renderText({input$var3})
var4 <- renderText({input$var4})
var5 <- renderText({input$var5})
# if (class==TRUE) {
# varnames <- append(varnames, "class")
# }
# var6 <- renderText({input$var6})
# var7 <- renderText({input$var7})
output$studyid <- renderUI({
selectInput("var1", "Study ID", colnames(myData()), selected = ifelse(is.null(input$file),'Study_No',NULL)) # colnames(as.data.frame(myData()))
})
output$drug <- renderUI({
selectInput("var2", "Intervention", colnames(myData()), selected = ifelse(is.null(input$file),'Drug',NULL)) # colnames(as.data.frame(myData()))
})
output$dose <- renderUI({
selectInput("var3", "Dose", colnames(myData()), selected = ifelse(is.null(input$file),'Dose_delivered_mean',NULL)) # colnames(as.data.frame(myData()))
})
output$r <- renderUI({
selectInput("var4", "Events", colnames(myData()), selected = ifelse(is.null(input$file),'Responders',NULL)) # colnames(as.data.frame(myData()))
})
output$n <- renderUI({
selectInput("var5", "Sample size", colnames(myData()), selected = ifelse(is.null(input$file),'No_randomised',NULL)) # colnames(as.data.frame(myData()))
})
output$class <- renderUI({
selectInput("var6", "Class", c(NA,colnames(myData()))) # colnames(as.data.frame(myData()))
})
output$cov1 <- renderUI({
selectInput("var7", "Covariate 1", c(NA,colnames(myData()))) # colnames(as.data.frame(myData()))
})
output$cov2 <- renderUI({
selectInput("var7", "Covariate 2", c(NA,colnames(myData()))) # colnames(as.data.frame(myData()))
})
output$cov3 <- renderUI({
selectInput("var7", "Covariate 3", c(NA,colnames(myData()))) # colnames(as.data.frame(myData()))
})
# output$dosetype <- renderUI({
# selectInput("dosetype", "The doses are", c('drug-specific','harmonized'), selected = 'drug-specific') # colnames(as.data.frame(myData()))
# })
# change column names
renameData <- reactive({
newDF1 <- subset(myData(),select=c(var1(),var2(),var3(),var4(),var5())) # ,var6(),var7()
names(newDF1) <- c('studyid','drug','dose','r','n') # ,'class','covariate'
# if (var6()!='NULL') {
# names(newDF1) <- append(varnames, "class")
# }
# if (var7()!='NULL' | var8()!='NULL' | var9()!='NULL' ) {
# names(newDF1) <- append(varnames, "covariate")
# }
newDF1
})
# remove NA's
cleanData <- reactive({
newDF2 <- removeNAdosresdata.fun(renameData())$dataset
newDF2 <- newDF2[newDF2$exclude==FALSE,]
newDF2
})
# exculded studies
output$outStudy <- renderText({
excStudy <- removeNAdosresdata.fun(renameData())$out # use the cleaned data to all outputs below
rbind(excStudy)
})
# 1.3 Reformat data
output$newDF <- DT::renderDataTable({
DT::datatable(cleanData())
})
#** Explore data
# network diagram
output$netplot <- renderPlot({
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net.plot(myd,node.scale = input$node,edge.scale = input$edge) # 0.2 0.25
})
# another network diagrams using MBNMAdose package
output$netplot2 <- renderPlot({
antidepdataN <- data.frame(studyID=as.numeric(as.factor(cleanData()$studyid)),agent=cleanData()$drug,dose=cleanData()$dose,
r=cleanData()$r,N=cleanData()$n)
datatnet <- mbnma.network(antidepdataN)
plot(datatnet,level='treatment',v.scale = input$node,edge.scale = input$edge,label.distance=input$label,
vertex.color=input$v.color,edge.color=input$e.color,remove.loops=input$removeLoops)
})
output$netplot3 <- renderPlot({
antidepdataN <- data.frame(studyID=as.numeric(as.factor(cleanData()$studyid)),agent=cleanData()$drug,dose=cleanData()$dose,
r=cleanData()$r,N=cleanData()$n)
datatnet <- mbnma.network(antidepdataN)
plot(datatnet,level='agent',v.scale = input$node,edge.scale = input$edge,label.distance=input$label,vertex.color=input$v.color,edge.color=input$e.color,remove.loops=input$removeLoops)
})
output$netplot4 <- renderPlot({
antidepdataN <- data.frame(studyID=as.numeric(as.factor(cleanData()$studyid)),agent=cleanData()$drug,dose=cleanData()$dose,
r=cleanData()$r,N=cleanData()$n)
datatnet <- mbnma.network(antidepdataN)
plot(datatnet,level='agent',doselink=2,v.scale = input$node,edge.scale = input$edge, label.distance=input$label,vertex.color=input$v.color,edge.color=input$e.color,remove.loops=input$removeLoops)
})
# table of network characteristics
output$tab1 <- renderTable({
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$network
})
# table of intervention characteristics
output$tab2 <- renderTable({
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$intervention[,c('drug','n.studies','n.events','n.patients')]
})
# table of comparison characteristics
output$tab3 <- renderTable({
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$comparison[,c('comparison','n.studies','n.patients')]
})
# Explore Data
# download files
output$downloadData <- downloadHandler(
filename = function() {
paste('data-', Sys.Date(), '.csv', sep='')
},
content = function(con) {
write.csv(cleanData(), con)
}
)
output$downloadTable3 <- downloadHandler(
filename = function() {
paste('ComparisonCharTable-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net_tab <- net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$comparison
write.table(net_tab,file,sep = ',')
}
)
output$downloadTable2 <- downloadHandler(
filename = function() {
paste('InterventionCharTable-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net_tab <- net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$intervention
write.table(net_tab,file,sep = ',')
}
)
output$downloadTable1 <- downloadHandler(
filename = function() {
paste('NetworkCharTable-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
net_tab <- net.tab(myd,outcome = 'r',N='n',type.outcome = 'binomial')$network
write.table(net_tab,file,sep = ',')
}
)
output$downloadNetPlot <- downloadHandler( # does not execute
filename = function() {
paste('NetPlot', Sys.Date(), '.pdf', sep='')
},
content = function(file) {
myd <- data.prep(cleanData(),varname.t = 'drug',varname.s = 'studyid')
pp <- net.plot(myd,node.scale = input$node,edge.scale = input$edge) # 0.2 0.23
# device <- function(..., width, height) {
# grDevices::png(..., width = width, height = height,
# res = 300, units = "in")
# }
# ggsave(file,pp,device = device)
pdf(file)
print(pp)
}
)
# n.chain <- reactive({input$n.chain})
# n.iter <- reactive({input$n.iter})
# n.burnin <- reactive({input$n.burnin})
# n.thin <- reactive({input$n.thin})
# Data analysis
fitjagsmodel <- reactive({
dosresnetmeta.jagsdata <- makeJAGSdata(data=cleanData(),metareg=F,class.effect=F,ref.lab='placebo',refclass.lab = 'placebo')
jagsmodelDRnetmeta<- makeJAGSmodel(metareg=F,effects='random',consistency=T,class.effect=F,doselink='spline')
dosresnetmeta.runjagsRCS <- jags.parallel(data = dosresnetmeta.jagsdata,inits=NULL,parameters.to.save = c('beta1','beta2','bb1','bb2','gamma','b1','b2','tau','Z','p.drug','dev','rhat','r','n','totresdev'),model.file = jagsmodelDRnetmeta,
n.chains=3,n.iter = 1000,n.burnin = 200,DIC=F,n.thin = 1)
dosresnetmeta.runjagsRCS
})
fitjagsmodelInc <- reactive({
dosresnetmeta.jagsdata <- makeJAGSdata(data=cleanData(),metareg=F,class.effect=F,ref.lab='placebo',refclass.lab = 'placebo')
jagsmodelDRnetmeta<- makeJAGSmodel(metareg=F,effects='random',consistency=F,class.effect=F,doselink='spline')
dosresnetmeta.runjagsRCSInc <- jags.parallel(data = dosresnetmeta.jagsdata,inits=NULL,parameters.to.save = c('beta1','beta2','bb1','bb2','gamma','b1','b2','tau','Z','p.drug'),model.file = jagsmodelDRnetmeta,
n.chains=3,n.iter = 1000,n.burnin = 200,DIC=F,n.thin = 1)
dosresnetmeta.runjagsRCSInc
})
# Forest plot
output$forestplot <- renderPlot({
x <- fitjagsmodel()
drug.lab <- levels(cleanData()$drug)
forestplot(x=x,drug.lab = drug.lab)
})
output$tau <- renderText({
paste0("\t",'Mean of ', 'tau',': ',round(fitjagsmodel()$BUGSoutput$summary['tau','mean'],3))
})
output$ci <- renderText({
paste0(' Credible Interval (CI): [', round(fitjagsmodel()$BUGSoutput$summary['tau','2.5%'],3),', ',
round(fitjagsmodel()$BUGSoutput$summary['tau','97.5%'],3), ']')
})
# Predicted absolute response plot
output$absoluteplot <- renderPlot({
x <- fitjagsmodel()
drug.lab <- levels(cleanData()$drug)
ref.lab <- 'placebo'
absolutePredplot(x=x,ref.lab='placebo',refclass.lab='placebo',drug.lab=drug.lab, class.lab=NULL,class.effect=F)
})
output$convTab <- renderTable({
x <- fitjagsmodel()
drug.lab <- levels(cleanData()$drug)
converge.table(x=x,ref.lab='placebo',refclass.lab='placebo',drug.lab=drug.lab, class.lab=NULL,class.effect=F)
})
output$hist1 <- renderPlot({
x <- fitjagsmodel()
histDRparam(x=x,metareg=F,class.effect=F)
})
output$hist2 <- renderPlot({
x <- fitjagsmodel()
drug.labs <- levels(cleanData()$drug)
ndrugs <- length(drug.labs)
param.labs <- c(paste0('d[',(1:ndrugs)[-ref],']'),paste0('d2[',(1:ndrugs)[-ref],']'))
len <- prod(dim(x$BUGSoutput$sims.array[,,'d[1]']))
plotdata <- data.frame(sim=c(x$BUGSoutput$sims.array[,,param.labs]),param=rep(param.labs,each=len))
plotdata2 <- plotdata[plotdata$param%in%param.labs[(ndrugs):(2*ndrugs-2)],]
g <- ggplot(plotdata2, aes(x=sim)) +
geom_histogram(alpha=0.6, binwidth = 0.002,color="darkblue", fill="lightblue")
g <- g + ggplot2::facet_wrap(~plotdata2$param,scales = 'free')
g <- g + ggplot2::labs(y="Frequency", x="iterations")
g
})
output$sucraPlot <- renderPlot({
x <- fitjagsmodel()
drug.lab <- levels(cleanData()$drug)
sucraPlot(x=x,ref.lab='placebo',refclass.lab='placebo',drug.lab=drug.lab, class.lab=NULL,class.effect=F)
})
# consistency-inconsistency agreement plot
output$ConIncon1 <- renderPlot({
cons.model <- fitjagsmodel()
incons.model <- fitjagsmodelInc()
comp <- direct.comp.index(cleanData())
direct.lab <- paste0('bb1[',comp[,'t1'],',',comp[,'t2'],']')
cons.icons.Plot(cons.model, incons.model,direct.lab)
})
output$ConIncon2 <- renderPlot({
cons.model <- fitjagsmodel()
incons.model <- fitjagsmodelInc()
comp <- direct.comp.index(cleanData())
direct.lab <- paste0('bb2[',comp[,'t1'],',',comp[,'t2'],']')
cons.icons.Plot(cons.model, incons.model,direct.lab)
})
output$fitplot <- renderPlot({
x <- fitjagsmodel()
fitplot(x)
})
}
# Run the application
shinyApp(ui = ui, server = server)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.