inst/shiny/server.R
In Ibrahimhassan94/MAAS: Meta-analysis with R via shiny
server <-
# auth0::auth0_server(
function(input, output, session) {
# bs_themer()
# original code: Don't touch or edit
# alert("Be varful")
output$whatsnew <- renderUI(includeHTML("./version.html"))
# validate input sheet and skip: ----
positivesheet <- reactive({
positive <- input$sheet >= 1
shinyFeedback::feedbackWarning("sheet",!positive, "Please select an integer number >= 1")
})
output$positivesheet <- renderText(positivesheet())
positiveskip <- reactive({
positive <- input$Skip >= 0
shinyFeedback::feedbackWarning("Skip",!positive, "Please select an integer number >= 0")
})
output$positiveskip <- renderText(positiveskip())
# Data import: ----
MyDat <- reactive({
req(input$sheet >= 1)
req(input$Skip >= 0)
req(input$file1)
# req(input$delc)
# req(input$delr)
v <- input$file1$datapath
u <- file_ext(v)
df <- switch(u,
#csv = utils::read.csv(v, header = input$header,sep = input$sep,quote = input$quote),
csv = vroom::vroom(v,n_max = input$nmax, col_names = input$Colname,
skip = input$Skip, delim = input$sep, quote = input$quote),
tsv = vroom::vroom(v, delim = "\t"),
xlsx = readxl::read_excel(v, n_max = input$nmax, sheet = input$sheet,
col_names = input$Colname,skip = input$Skip),
validate("Invalid file; Please upload a .csv or .tsv or .xls /.xlsx file")
)
# df <- as.data.frame(df)
df<- delrows(input$delr,df)
df <- delcols(input$delc,df)
{
# df <- if(u == 'csv'){
# # csv
# {
# utils::read.csv(v,
# header = input$header,
# sep = input$sep,
# quote = input$quote)
# }
# } else {
# # excel
# {
# readxl::read_excel(v, n_max = input$nmax,
# sheet = input$sheet,
# col_names = input$Colname,
# skip = input$Skip)
# }
# }
}
return(df)
})
# observeEvent(c(MyDat()),{
# updateTextAreaInput(session,'cols', value = paste(' ',colnames(MyDat()),' '))
# })
# update number of columns and rows to delete
observeEvent(input$file1,
{
updateSelectInput(session,'delr', choices = c(1:nrow(MyDat())))
updateSelectInput(session,'delc', choices = c(1:ncol(MyDat())))
}
)
output$cleaneddata <- renderTable({
if(is.null(input$file1)){
'No data has been imported'
} else {
if(input$disp == "head") {
head(MyDat())
} else {
MyDat()
}
}
})
# Mean ----
{
# data, summary, table ----
MeanData <- reactive({
if(is.null(input$file1)){
meand <- gtdata('Mean') # Mean dataframe in global file
meand$Study <- as.factor(meand$Study)
meand <- delrows(input$delr,meand)
meand <- delcols(input$delc,meand)
return(meand)
} else {return(MyDat())}
})
output$Meant <- renderTable({
chek <- function(n,h){
b <- 0
for (i in n) {
if(i %in% h){
b = b+1
} else {
b = b
}
}
return(b)
}
if(chek(Meanreqcol,colnames(MeanData())) == 3){
if(input$disp == "head") {
return(head(MeanData()))
} else {return( MeanData())
}
} else {'Error! Please revise the uploaded data for appropriate format'}
})
output$Meansummarydata <- renderPrint({
if(chek(Meanreqcol,colnames(MeanData())) == 3){
dataset <- MeanData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
observeEvent(MeanData(),
updateSelectInput(session,'MEANsubgroup', selected = 'NULL', choices = c('NULL', getsubgroupvar(MeanData(),Meanreqcol)))
)
# Meta object, summary model, publication bias ----
Meanmodel <- reactive({
Mean <- MeanData()
# if(input$MEANsubgroup == 'NULL'){
# x = eval(parse(text = 'NULL'))
# } else{
# x <- eval(parse(text = paste0('Mean','$',input$MEANsubgroup)))
# }
meta::metamean(
mean = mean, sd = sd, n = n,
studlab = paste(Study), #byvar = x,
data = Mean, sm = input$MEANsm, backtransf = input$MEANbackTfor,
comb.random = input$Meanrandom, comb.fixed = input$Meanfixed, prediction = T,
method.tau = input$MEANmethodtau, hakn = TRUE
)
})
output$Mean.model <- renderPrint({
summary(Meanmodel())
})
output$MEANpubBias <- renderPrint({
getbias(Meanmodel())
})
output$Meanbias <- renderUI({
g <- eggers.test(Meanmodel())
df <- data.frame(
intercept <- c(round(g$intercept,2)),
`95% CI` <- c(paste0(round(g$llci,2),' - ' ,round(g$ulci,2))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
# column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(Meanmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
MeanData(),
updateSelectInput(session,'MEANregfactor',
choices = c(getsubgroupvar(MeanData(),Meanreqcol)))
)
Meanregmodel <- reactive({
req(input$MEANregfactor)
a <- input$MEANregfactor
b <- pastreg(a,input$Meanmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = Meanmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$Mean.regmodel <- renderPrint({
req(input$MEANregfactor)
Meanregmodel()
})
# sensetvity analysis ----
output$MEANbasicO <- renderPrint({
find.outliers(Meanmodel())
})
MEANsens <- reactive({
InfluenceAnalysis(x = Meanmodel(),random = TRUE)
})
output$MEANsens_sum <- renderPrint({
MEANsens()
})
output$MEANsens_Bplot <- renderUI({
output$MEANsens_Bplot2 <- renderPlot({
x <- MEANsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('MEANsens_Bplot2')
})
output$MEANsens_ForestI2 <- renderUI({
output$MEANsens_ForestI22 <- renderPlot({
plot(MEANsens()$ForestI2)
})
plotOutput('MEANsens_ForestI22')
})
output$MEANsens_ForestEffectsize <- renderUI({
output$MEANsens_ForestEffectsize2 <- renderPlot({
plot(MEANsens()$ForestEffectSize)
})
plotOutput('MEANsens_ForestEffectsize2')
})
output$MEANsens_InfluenceCharacteristics <- renderUI({
output$MEANsens_InfluenceCharacteristics2 <- renderPlot({
plot(MEANsens()$InfluenceCharacteristics)
})
plotOutput('MEANsens_InfluenceCharacteristics2')
})
output$MEANpcurve <- renderUI({
observeEvent(c(input$MEANWc,input$MEANHc,input$MEANResc),{
output$MEANpcurve2 <- renderPlot(
width = input$MEANWc,
height =input$MEANHc,
res = input$MEANResc,
{
pcurve(Meanmodel())
}
)
}
)
plotOutput('MEANpcurve2')
})
output$downloadMEANpcurveplot <- {downloadHandler(
filename = function() {
paste('Mean Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$MEANHc*2 ,width = input$MEANWc*2, res = input$MEANResc*2)
{
pcurve(Meanmodel())
}
dev.off()
}
)}
Meanmodel.rma <- reactive({
# rma(measure = 'MN', ni= n, mi= mean, sdi = sd, data = MeanData(),
# method = Meanmodel()$method.tau,
# test = "knha")
rma(yi = Meanmodel()$TE,
sei = Meanmodel()$seTE,
method = Meanmodel()$method.tau,
test = "knha")
})
MEANgosh <- reactive({
gosh(Meanmodel.rma())
})
output$MEANgosh_plot <- renderUI({
output$MEANgosh_plot2 <- renderPlot({
plot(MEANgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('MEANgosh_plot2')
})
MEANgoshdiagnostics <- reactive({
x <- gosh.diagnostics(MEANgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$MEANgosh_sum <- renderPrint({
MEANgoshdiagnostics()
})
output$MEANgoshdiag_plot <- renderUI({
output$MEANgoshdiag_plot2 <- renderPlot({
plot(MEANgoshdiagnostics())
})
plotOutput('MEANgoshdiag_plot2')
})
# plots ----
observeEvent(
input$MEANsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$MEANsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'MEANrghtlabl', value = y)}
)
output$MEANforestplot <- renderUI({
observeEvent(c(input$MEANW,input$MEANH,input$MEANRes),
{
output$MEANforestplot2 <- renderPlot(
width = input$MEANW,
height = input$MEANH,
res = input$MEANRes,
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
#x <- Meanmodel()[names(Meanmodel()) == paste(input$MEANsortvar)]
MEANlftlb <- getchar(input$MEANlftlabl,',')
MEANlftcl <- getchar(input$MEANlftclm, ', ')
MEANrghtcl <- getchar(input$MEANrghtclm, ', ')
MEANrghtlb <- getchar(input$MEANrghtlabl,',')
# MEANrghtlb <- getchar(c(eval(parse(text = "Meanmodel()$sm")),getchar(input$MEANrghtlabl,',')),',')
forest.meta(
Meanmodel(), xlim = c(input$minMEANxlim,input$maxMEANxlim),
sortvar = unlist(Meanmodel()[input$MEANsortvar]) ,
rightcols = MEANrghtcl,
rightlabs = MEANrghtlb,
leftcols = MEANlftcl,
leftlabs = MEANlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$MEANcolFdiamond,
# col.diamond.lines = "black",
col.square = input$MEANcolFStud,
#col.square.lines = 'grey60',
col.predict = input$MEANcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$MEANcolgap,'cm')
)
grid::grid.text(input$MEANtitleforest, input$MEANHtitleoffset, input$MEANVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
plotOutput('MEANforestplot2',width= paste0(input$MEANW,'px'), height = paste0(input$MEANH,'px'))
})
output$MEANfunnelplot <- renderUI({
observeEvent(c(input$MEANWp,input$MEANHp,input$MEANResp),
{output$MEANfunnelplot2 <- renderPlot(
width = input$MEANWp,
height = input$MEANHp,
res = input$MEANResp,
{funnel(
Meanmodel()$TE, Meanmodel()$seTE,
level=c(90, 95, 99),
refline = Meanmodel()$TE.random,
main= input$MEANfunneltitle,
xlim = c(min(Meanmodel()$mean),max(Meanmodel()$mean)),
shade=c("white", "red", "orange"),
cex = input$MEANfunnelcex,
col = input$MEANfunnelstudy ,
back = input$MEANfunnelbg)}
)}
)
plotOutput('MEANfunnelplot2',width= paste0(input$MEANWp,'px'), height = paste0(input$MEANHp,'px'))
})
output$MEANdraperyplot <- renderUI({
observeEvent(c(input$MEANWd,input$MEANHd,input$MEANResd),{
output$MEANdraperyplot2 <- renderPlot(
width = input$MEANWd,
height = input$MEANHd,
res = input$MEANResd,
{drapery(
Meanmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minMEANxlimd,input$maxMEANxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$MEANDraperytitle
)
}
)}
)
plotOutput('MEANdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadMEANforestplot <- {downloadHandler(
filename = function() {
paste(input$MEANtitleforest, "png", sep = '.')
},
content = function(file) {
png(file,height = input$MEANH*1.5 ,width = input$MEANW*1.5, res = input$MEANRes*1.5)
{
{
MEANlftlb <- getchar(input$MEANlftlabl,',')
MEANlftcl <- getchar(input$MEANlftclm, ', ')
MEANrghtcl <- getchar(input$MEANrghtclm, ', ')
MEANrghtlb <- getchar(input$MEANrghtlabl,',')
# MEANrghtlb <- getchar(c(eval(parse(text = "Meanmodel()$sm")),getchar(input$MEANrghtlabl,',')),',')
forest(
Meanmodel(), xlim = c(input$minMEANxlim,input$maxMEANxlim),
sortvar = unlist(Meanmodel()[input$MEANsortvar]) ,
rightcols = MEANrghtcl,
rightlabs = MEANrghtlb,
leftcols = MEANlftcl,
leftlabs = MEANlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$MEANcolFdiamond,
# col.diamond.lines = "black",
col.square = input$MEANcolFStud,
#col.square.lines = 'grey60',
col.predict = input$MEANcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$MEANcolgap,'cm')
)
grid::grid.text(input$MEANtitleforest, input$MEANHtitleoffset, input$MEANVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
}
dev.off()
}
)}
output$downloadMEANfunnelplot <- {downloadHandler(
filename = function() {
paste( input$MEANfunneltitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$MEANHp ,width = input$MEANWp, res = input$MEANResp)
{
funnel(
Meanmodel()$TE, Meanmodel()$seTE, level=c(90, 95, 99),
main= input$MEANfunneltitle, xlim = c(input$minMEANxlimp,input$maxMEANxlimp),
shade=c("white", "red", "orange"),
cex = input$MEANfunnelcex, col = input$MEANfunnelstudy ,back = input$MEANfunnelbg)
}
dev.off()
}
)}
output$downloadMEANDraperyplot <- {downloadHandler(
filename = function() {
paste(input$MEANDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$MEANHd*2 ,width = input$MEANWd*2, res = input$MEANResd*2)
{
drapery(
Meanmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minMEANxlimd,input$maxMEANxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$MEANDraperytitle
)
}
dev.off()
}
)}
# data download:
output$exMEAN <- {downloadHandler(
filename = function() {
paste('Mean dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(MeanData(),file)
}
)}
# trim fill :
MEANtrimfill <- reactive({
x <- trimfill(Meanmodel())
x$sd <- sdtrimfill(Meanmodel(),x)
x$mean <- meantrimfill(Meanmodel(),x)
return(x)
})
output$MEANtrimfillmodel <- renderPrint(MEANtrimfill())
observeEvent(c(input$MEANW,input$MEANH,input$MEANRes),
{output$MEANtrimfillforest <- renderPlot(
width = input$MEANW,
height = input$MEANH,
res = input$MEANRes,
{
MEANlftlb <- getchar(input$MEANlftlabl,',')
MEANlftcl <- getchar(input$MEANlftclm, ', ')
MEANrghtcl <- getchar(input$MEANrghtclm, ', ')
MEANrghtlb <- getchar(input$MEANrghtlabl,',')
# MEANrghtlb <- getchar(c(eval(parse(text = "MEANmodel()$sm")),getchar(input$MEANrghtlabl,',')),',')
forest(
MEANtrimfill(), xlim = c(input$minMEANxlim,input$maxMEANxlim),
sortvar = unlist(MEANtrimfill()[input$MEANsortvar]),
rightcols = MEANrghtcl,
rightlabs = MEANrghtlb,
leftcols = MEANlftcl,
leftlabs = MEANlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$MEANcolFdiamond,
# col.diamond.lines = "black",
col.square = input$MEANcolFStud,
#col.square.lines = 'grey60',
col.predict = input$MEANcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$MEANcolgap,'cm')
)
grid::grid.text(input$MEANtitleforest, input$MEANHtitleoffset, input$MEANVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$MEANWp,input$MEANHp,input$MEANResp),
{
output$MEANtrimfillfunnel <- renderPlot(
width = input$MEANWp,
height = input$MEANHp,
res = input$MEANResp,
funnel(
MEANtrimfill()$TE,MEANtrimfill()$seTE,
main= input$MEANfunneltitle,
xlim = c(min(MEANtrimfill()$mean),max(MEANtrimfill()$mean)),
refline = MEANtrimfill()$TE.random,
pch = ifelse(MEANtrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$MEANfunnelcex,
col = input$MEANfunnelstudy ,
back = input$MEANfunnelbg)
)
}
)
observeEvent(c(input$MEANWd,input$MEANHd,input$MEANResd),
{
output$MEANtrimfilldrapery <- renderPlot(
width = input$MEANWd,
height = input$MEANHd,
res = input$MEANResd,
{drapery(
MEANtrimfill(), type = "pval", legend = T,
labels = "studlab",
# xlim = c(min(MEANtrimfill()$mean),max(MEANtrimfill()$mean)),
xlim = c(input$minMEANxlimd,input$maxMEANxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$MEANDraperytitle
)
}
)
}
)
}
# SMD ----
{
{
# metaobject <- reactive({
# mg <- SMDData()
# mg$mean.e <- as.numeric(mg$mean.e)
# mg$n.e <- as.numeric(mg$n.e)
# mg$sd.e <- as.numeric(mg$sd.e)
# mg$mean.c <- as.numeric(mg$mean.c)
# mg$n.c <- as.numeric(mg$n.c)
# mg$sd.c <- as.numeric(mg$sd.c)
# model <- meta::metacont(
# mean.e = mean.e,
# sd.e = sd.e,
# n.e= n.e,
# mean.c= mean.c,
# sd.c = sd.c,
# n.c = n.c,
# data = mg,
# sm = 'SMD',
# comb.random = T, comb.fixed = F,
# prediction = T,
# studlab = paste(Study),
# method.tau = input$methodtau, method.smd = input$methodsmd,
# label.e = 'Sicklers', label.c = 'Non-Sicklers',
# )
# return(model)
# })
}
SMDData <- reactive({
if(is.null(input$file1)){
SMD <- gtdata('SMD')
SMD$Study <- as.factor(SMD$Study)
SMD <- delrows(input$delr,SMD)
SMD <- delcols(input$delc,SMD)
return(SMD)
} else {
MyDat()
}
})
output$SMDt <- renderTable({
if(chek(SMDreqcol,colnames(SMDData())) == 6){
if(input$disp == "head") {
return(head(SMDData()))
} else {
return(SMDData())
}
} else {
'Error! Please revise the uploaded data for appropriate format'
}
#SMDData()
})
output$SMDsummarydata <- renderPrint({
if(chek(SMDreqcol,colnames(SMDData())) == 6){
dataset <- SMDData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
# subgroup variables:
observeEvent(SMDData(),
updateSelectInput(session,'SMDsubgroup', selected = 'NULL',
choices = c('NULL', getsubgroupvar(SMDData(),SMDreqcol)))
)
SMDmodel <- reactive({
SMD <- SMDData()
if(input$SMDsubgroup == 'NULL'){
x = eval(parse(text = 'NULL'))
} else{
x <- eval(parse(text = paste0('SMD$',input$SMDsubgroup)))
}
SMD$mean.e <- as.numeric(SMD$mean.e)
SMD$n.e <- as.numeric(SMD$n.e)
SMD$sd.e <- as.numeric(SMD$sd.e)
SMD$mean.c <- as.numeric(SMD$mean.c)
SMD$n.c <- as.numeric(SMD$n.c)
SMD$sd.c <- as.numeric(SMD$sd.c)
model <- meta::metacont(
mean.e = mean.e, sd.e = sd.e, n.e= n.e,
mean.c= mean.c, sd.c = sd.c, n.c = n.c,
data = SMD, sm = input$SMDsm, byvar = x,
comb.random = input$SMDrandom, comb.fixed = input$SMDfixed, prediction = T,
studlab = paste(Study), label.e = input$SMDintervention ,
label.c = input$SMDcontrol,
method.tau = input$SMDmethodtau, method.smd = input$SMDmethodsmd)
})
output$SMD.model <- renderPrint({
summary(SMDmodel())
})
output$SMDpubBias <- renderPrint(
getbias(SMDmodel())
)
output$SMDbias <- renderUI({
g <- eggers.test(SMDmodel())
df <- data.frame(
intercept <- c(round(g$intercept,3)),
`95% CI` <- c(paste0(round(g$llci,3),' - ' ,round(g$ulci,3))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(SMDmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
SMDData(),
updateSelectInput(session,'SMDregfactor',
choices = c(getsubgroupvar(SMDData(),SMDreqcol)))
)
SMDregmodel <- reactive({
req(input$SMDregfactor)
a <- input$SMDregfactor
b <- pastreg(a,input$SMDmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = SMDmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$SMD.regmodel <- renderPrint({
req(input$SMDregfactor)
summary(SMDregmodel())
})
# Sensitivity analysis ----
output$SMDbasicO <- renderPrint({
find.outliers(SMDmodel())
})
SMDsens <- reactive({
InfluenceAnalysis(x = SMDmodel(),random = TRUE)
})
output$SMDsens_sum <- renderPrint({
SMDsens()
})
output$SMDsens_Bplot <- renderUI({
output$SMDsens_Bplot2 <- renderPlot({
x <- SMDsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('SMDsens_Bplot2')
})
output$SMDsens_ForestI2 <- renderUI({
output$SMDsens_ForestI22 <- renderPlot({
plot(SMDsens()$ForestI2)
})
plotOutput('SMDsens_ForestI22')
})
output$SMDsens_ForestEffectsize <- renderUI({
output$SMDsens_ForestEffectsize2 <- renderPlot({
plot(SMDsens()$ForestEffectSize)
})
plotOutput('SMDsens_ForestEffectsize2')
})
output$SMDsens_InfluenceCharacteristics <- renderUI({
output$SMDsens_InfluenceCharacteristics2 <- renderPlot({
plot(SMDsens()$InfluenceCharacteristics)
})
plotOutput('SMDsens_InfluenceCharacteristics2')
})
output$SMDpcurve <- renderUI({
observeEvent(c(input$SMDWc,input$SMDHc,input$SMDResc),{
output$SMDpcurve2 <- renderPlot(
width = input$SMDWc,
height =input$SMDHc,
res = input$SMDResc,
{
pcurve(SMDmodel())
}
)
}
)
plotOutput('SMDpcurve2')
})
output$downloadSMDpcurveplot <- {downloadHandler(
filename = function() {
paste('SMD Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$SMDHc*2 ,width = input$SMDWc*2, res = input$SMDResc*2)
{
pcurve(SMDmodel())
}
dev.off()
}
)}
SMDmodel.rma <- reactive({
# rma(measure = 'MN', ni= n, mi= SMD, sdi = sd, data = SMDData(),
# method = SMDmodel()$method.tau,
# test = "knha")
rma(yi = SMDmodel()$TE,
sei = SMDmodel()$seTE,
method = SMDmodel()$method.tau,
test = "knha")
})
SMDgosh <- reactive({
gosh(SMDmodel.rma())
})
output$SMDgosh_plot <- renderUI({
output$SMDgosh_plot2 <- renderPlot({
plot(SMDgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('SMDgosh_plot2')
})
SMDgoshdiagnostics <- reactive({
x <- gosh.diagnostics(SMDgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$SMDgosh_sum <- renderPrint({
SMDgoshdiagnostics()
})
output$SMDgoshdiag_plot <- renderUI({
output$SMDgoshdiag_plot2 <- renderPlot({
plot(SMDgoshdiagnostics())
})
plotOutput('SMDgoshdiag_plot2')
})
# plots ----
observeEvent(
input$SMDsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$SMDsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'SMDrghtlabl', value = y)}
)
# plots
output$SMDforestplot <- renderUI({
observeEvent(c(input$SMDW,input$SMDH,input$SMDRes),
{output$SMDforestplot2 <- renderPlot(
width = input$SMDW,
height = input$SMDH,
res = input$SMDRes,
{
SMDlftlb <- getchar(input$SMDlftlabl,',')
SMDlftcl <- getchar(input$SMDlftclm, ', ')
SMDrghtcl <- getchar(input$SMDrghtclm, ', ')
SMDrghtlb <- getchar(input$SMDrghtlabl,',')
# SMDrghtlb <- getchar(c(eval(parse(text = "SMDmodel()$sm")),getchar(input$SMDrghtlabl,',')),',')
forest(
SMDmodel(),
sortvar= unlist(SMDmodel()[input$SMDsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("SMD","95% CI"," Weight"),
rightcols = SMDrghtcl,
rightlabs = SMDrghtlb,
leftcols = SMDlftcl,
leftlabs = SMDlftlb,
pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$SMDcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$SMDcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$SMDcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$SMDtitleforest, input$SMDHtitleoffset, input$SMDVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
plotOutput('SMDforestplot2',width= paste0(input$SMDW,'px'), height = paste0(input$SMDH,'px'))
})
output$SMDfunnelplot <- renderUI({
observeEvent(c(input$SMDWp,input$SMDHp,input$SMDResp),
{output$SMDfunnelplot2 <- renderPlot(
width = input$SMDWp,
height = input$SMDHp,
res = input$SMDResp,
{funnel(
SMDmodel()$TE,SMDmodel()$seTE,
main= input$SMDfunneltitle,
# refline = SMDmodel()$TE.random,
# xlim = c(input$minSMDxlimp,input$maxSMDxlimp),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$SMDfunnelcex,
col = input$SMDfunnelstudy ,
back = input$SMDfunnelbg)
}
)}
)
plotOutput('SMDfunnelplot2',width= paste0(input$SMDWp,'px'), height = paste0(input$SMDHp,'px'))
})
output$SMDdraperyplot <- renderUI({
observeEvent(c(input$SMDWd,input$SMDHd,input$SMDResd),{
output$SMDdraperyplot2 <- renderPlot(
width = input$SMDWd,
height = input$SMDHd,
res = input$SMDResd,
{drapery(
SMDmodel(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minSMDxlimd,input$maxSMDxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$SMDDraperytitle
)
}
)}
)
plotOutput('SMDdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadSMDforestplot <- {downloadHandler(
filename = function() {
paste(input$SMDtitleforest, "png", sep = '.')},
content = function(file) {
png(file,height = input$SMDH*1.5 ,width = input$SMDW*1.5, res = input$SMDRes*1.5)
{
SMDlftlb <- getchar(input$SMDlftlabl,',')
SMDlftcl <- getchar(input$SMDlftclm, ', ')
SMDrghtcl <- getchar(input$SMDrghtclm, ', ')
SMDrghtlb <- getchar(input$SMDrghtlabl,',')
# SMDrghtlb <- getchar(c(eval(parse(text = "SMDmodel()$sm")),getchar(input$SMDrghtlabl,',')),',')
forest(
SMDmodel(),
sortvar= unlist(SMDmodel()[input$SMDsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("SMD","95% CI"," Weight"),
#leftcols = smdlftcl,
# #c("Study", "n.e","mean.e","sd.e","n.c","mean.c","sd.c"),
rightcols = SMDrghtcl,
rightlabs = SMDrghtlb,
leftcols = SMDlftcl,
leftlabs = SMDlftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$SMDcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$SMDcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$SMDcolFpred,
print.pval.Q = SMDmodel()$pval.random,
digits.sd = 2
)
grid::grid.text(input$SMDtitleforest, input$SMDHtitleoffset, input$SMDVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
dev.off()
}
)}
output$downloadSMDfunnelplot <- {downloadHandler(
filename = function() {
paste(input$SMDfunneltitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$SMDHp ,width = input$SMDWp, res = input$SMDResp)
{
funnel(SMDmodel()$TE,SMDmodel()$seTE,
main= input$SMDfunneltitle, xlim = c(input$minSMDxlimp,input$maxSMDxlimp),
level=c(90, 95, 99), shade=c("white", "red", "orange"),
cex = input$SMDfunnelcex, col = input$SMDfunnelstudy ,back = input$SMDfunnelbg)
}
dev.off()
}
)}
output$downloadSMDDraperyplot <- {downloadHandler(
filename = function() {
paste(input$SMDDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$SMDHd*2 ,width = input$SMDWd*2, res = input$SMDResd*2)
{
drapery(
SMDmodel(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minSMDxlimd,input$maxSMDxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$SMDDraperytitle
)
}
dev.off()
}
)}
# data download:
output$exSMD <- {downloadHandler(
filename = function() {
paste('SMD dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(SMDData(),file)
}
)}
# trim fill :
SMDtrimfill <- reactive({
trimfill(SMDmodel())
})
output$SMDtrimfillmodel <- renderPrint(SMDtrimfill())
observeEvent(c(input$SMDW,input$SMDH,input$SMDRes),
{output$SMDtrimfillforest <- renderPlot(
width = input$SMDW,
height = input$SMDH,
res = input$SMDRes,
{
SMDlftlb <- getchar(input$SMDlftlabl,',')
SMDlftcl <- getchar(input$SMDlftclm, ', ')
SMDrghtcl <- getchar(input$SMDrghtclm, ', ')
SMDrghtlb <- getchar(input$SMDrghtlabl,',')
forest(
SMDtrimfill(),
sortvar= unlist(SMDtrimfill()[input$SMDsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("SMD","95% CI"," Weight"),
rightcols = SMDrghtcl,
rightlabs = SMDrghtlb,
leftcols = SMDlftcl,
leftlabs = SMDlftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$SMDcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$SMDcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$SMDcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$SMDtitleforest, input$SMDHtitleoffset, input$SMDVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$SMDWp,input$SMDHp,input$SMDResp),
{output$SMDtrimfillfunnel <- renderPlot(
width = input$SMDWp,
height = input$SMDHp,
res = input$SMDResp,
{funnel(
SMDtrimfill()$TE,SMDtrimfill()$seTE,
main= input$SMDfunneltitle,
# refline = SMDmodel()$TE.random,
# xlim = c(input$minSMDxlimp,input$maxSMDxlimp),
pch = ifelse(SMDtrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$SMDfunnelcex,
col = input$SMDfunnelstudy ,
back = input$SMDfunnelbg)
}
)}
)
observeEvent(c(input$SMDWd,input$SMDHd,input$SMDResd),{
output$SMDtrimfilldrapery <- renderPlot(
width = input$SMDWd,
height = input$SMDHd,
res = input$SMDResd,
{
drapery(
SMDtrimfill(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minSMDxlimd,input$maxSMDxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$SMDDraperytitle)
}
)}
)
}
# Prop ----
{
PropData <- reactive({
if(is.null(input$file1)){
Propd <- gtdata('Prop') # Prop dataframe in global file
Propd$Study <- as.factor(Propd$Study)
Propd <- delrows(input$delr,Propd)
Propd <- delcols(input$delc,Propd)
return(Propd)
} else {return(MyDat())}
})
output$Propt <- renderTable({
chek <- function(n,h){
b <- 0
for (i in n) {
if(i %in% h){
b = b+1
} else {
b = b
}
}
return(b)
}
if(chek(Propreqcol,colnames(PropData())) == 2){
if(input$disp == "head") {
return(head( PropData()))
} else {return( PropData())
}
} else {'Error! Please revise the uploaded data for appropriate format'}
})
output$Propsummarydata <- renderPrint({
if(chek(Propreqcol,colnames(PropData())) == 2){
dataset <- PropData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
observeEvent(PropData(),
updateSelectInput(session,'Propsubgroup', selected = 'NULL',
choices = c('NULL', getsubgroupvar(PropData(),Propreqcol)))
)
# Meta object:
Propmodel <- reactive({
Prop <- PropData()
Prop$n <- as.numeric(Prop$n)
Prop$event <- as.numeric(Prop$event)
if(input$Propsubgroup == 'NULL'){
x = eval(parse(text = 'NULL'))
} else{
x <- eval(parse(text = paste0('Prop$',input$Propsubgroup)))}
Propmeta <- meta::metaprop(
event = event, n = n,
studlab = paste(Study), byvar = x,
data = Prop, sm = input$Propsm, backtransf = input$PropbackTfor,
comb.random = input$Proprandom, comb.fixed = input$Propfixed, prediction = T,
method.tau = input$Propmethodtau, hakn = TRUE
)
})
output$Prop.model <- renderPrint({
summary(Propmodel())
})
output$ProppubBias <- renderPrint(
getbias(Propmodel())
)
output$Propbias <- renderUI({
g <- eggers.test(Propmodel())
df <- data.frame(
intercept <- c(round(g$intercept,3)),
`95% CI` <- c(paste0(round(g$llci,3),' - ' ,round(g$ulci,3))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(Propmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
PropData(),
updateSelectInput(session,'Propregfactor',
choices = c(getsubgroupvar(PropData(),Propreqcol)))
)
Propregmodel <- reactive({
req(input$Propregfactor)
a <- input$Propregfactor
b <- pastreg(a,input$Propmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = Propmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$Prop.regmodel <- renderPrint({
req(input$Propregfactor)
summary(Propregmodel())
})
# Sensitivity analysis ----
output$PropbasicO <- renderPrint({
find.outliers(Propmodel())
})
Propsens <- reactive({
InfluenceAnalysis(x = Propmodel(),random = TRUE)
})
output$Propsens_sum <- renderPrint({
Propsens()
})
output$Propsens_Bplot <- renderUI({
output$Propsens_Bplot2 <- renderPlot({
x <- Propsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('Propsens_Bplot2')
})
output$Propsens_ForestI2 <- renderUI({
output$Propsens_ForestI22 <- renderPlot({
plot(Propsens()$ForestI2, cex = 2)
})
plotOutput('Propsens_ForestI22')
})
output$Propsens_ForestEffectsize <- renderUI({
output$Propsens_ForestEffectsize2 <- renderPlot({
plot(Propsens()$ForestEffectSize)
})
plotOutput('Propsens_ForestEffectsize2')
})
output$Propsens_InfluenceCharacteristics <- renderUI({
output$Propsens_InfluenceCharacteristics2 <- renderPlot({
plot(Propsens()$InfluenceCharacteristics)
})
plotOutput('Propsens_InfluenceCharacteristics2')
})
output$Proppcurve <- renderUI({
observeEvent(c(input$PropWc,input$PropHc,input$PropResc),{
output$Proppcurve2 <- renderPlot(
width = input$PropWc,
height =input$PropHc,
res = input$PropResc,
{
pcurve(Propmodel())
}
)
}
)
plotOutput('Proppcurve2')
})
output$downloadProppcurveplot <- {downloadHandler(
filename = function() {
paste('Prop Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$PropHc*2 ,width = input$PropWc*2, res = input$PropResc*2)
{
pcurve(Propmodel())
}
dev.off()
}
)}
Propmodel.rma <- reactive({
# rma(measure = 'MN', ni= n, mi= Prop, sdi = sd, data = PropData(),
# method = Propmodel()$method.tau,
# test = "knha")
rma(yi = Propmodel()$TE,
sei = Propmodel()$seTE,
method = Propmodel()$method.tau,
test = "knha")
})
Propgosh <- reactive({
gosh(Propmodel.rma())
})
output$Propgosh_plot <- renderUI({
output$Propgosh_plot2 <- renderPlot({
plot(Propgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('Propgosh_plot2')
})
Propgoshdiagnostics <- reactive({
x <- gosh.diagnostics(Propgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$Propgosh_sum <- renderPrint({
Propgoshdiagnostics()
})
output$Propgoshdiag_plot <- renderUI({
output$Propgoshdiag_plot2 <- renderPlot({
plot(Propgoshdiagnostics())
})
plotOutput('Propgoshdiag_plot2')
})
# plot ----
observeEvent(
input$Propsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$Propsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'Proprghtlabl', value = y)}
)
# plots
output$Propforestplot <- renderUI({
observeEvent(c(input$PropW,input$PropH,input$PropRes),
{output$Propforestplot2 <- renderPlot(
width = input$PropW,
height = input$PropH,
res = input$PropRes,
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
Proplftlb <- getchar(input$Proplftlabl,',')
Proplftcl <- getchar(input$Proplftclm, ', ')
Proprghtcl <- getchar(input$Proprghtclm, ', ')
Proprghtlb <- getchar(input$Proprghtlabl,',')
# Proprghtlb <- getchar(c(eval(parse(text = "Propmodel()$sm")),getchar(input$Proprghtlabl,',')),',')
forest(
Propmodel(), xlim = c(input$minPropxlim,input$maxPropxlim),
sortvar = unlist(Propmodel()[input$Propsortvar]) ,
rightcols = Proprghtcl,
rightlabs = Proprghtlb,
leftcols = Proplftcl,
leftlabs = Proplftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
ref = 0.5,
smlab = paste(input$Propsmlabforest,'\n (0.5)'), # "Proportion \n (0.5)",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$PropcolFdiamond,
# col.diamond.lines = "black",
col.square = input$PropcolFStud,
#col.square.lines = 'grey60',
col.predict = input$PropcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$Propcolgap,'cm')
)
grid::grid.text(input$Proptitleforest, input$PropHtitleoffset, input$PropVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
plotOutput('Propforestplot2',width= paste0(input$PropW,'px'), height = paste0(input$PropH,'px'))
})
output$Propfunnelplot <- renderUI({
observeEvent(c(input$PropWp,input$PropHp,input$PropResp),
{output$Propfunnelplot2 <- renderPlot(
width = input$PropWp,
height = input$PropHp,
res = input$PropResp,
{
# funnel.meta(Propmodel())
funnel(Propmodel()$TE,Propmodel()$seTE,
main= input$Propfunneltitle,
# xlim = c(Propmodel()$TE.random-0.8,
# Propmodel()$TE.random+0.8),
# xlim = c(Propmodel()$TE.random-input$minPropxlimp,
# Propmodel()$TE.random+input$maxPropxlimp),
xlim = c(input$minPropxlimp, input$maxPropxlimp),
refline = Propmodel()$TE.random,
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$Propfunnelcex,
col = input$Propfunnelstudy ,
back = input$Propfunnelbg)
}
)}
)
plotOutput('Propfunnelplot2',width= paste0(input$PropWp,'px'), height = paste0(input$PropHp,'px'))
})
output$Propdraperyplot <- renderUI({
observeEvent(c(input$PropWd,input$PropHd,input$PropResd),{
output$Propdraperyplot2 <- renderPlot(
width = input$PropWd,
height = input$PropHd,
res = input$PropResd,
{drapery(
Propmodel(), type = "pval",
labels = "studlab",
main = input$PropDraperytitle,
pos.legend = 'topright',
xlim = c(0,1.5),
layout = 'linewidth'
# legend = T,
# xlim = c(input$minPropxlimd,input$maxPropxlimd),
# lwd.max = 2,
)
# legend(x= 1, y = 0.5,
# legend=c("Random effects model","Fixed effects model", "Range of predictions"),
# col=c("red", 'blue', "lightblue"),
# pch=19, lty = 1, lwd = 2,
# # cex = 1.1,
# # inset = c(-0.5,-0.05),
# x.intersp=0.5, xjust=0, yjust=0,
# horiz=F,
# bty='n')
}
)}
)
plotOutput('Propdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadPropforestplot <- downloadHandler(
filename = function() {
paste(input$Proptitleforest, "png", sep = '.')},
content = function(file) {
png(file,height = input$PropH*1.5 ,width = (input$PropW*1.5)+100, res = input$PropRes*1.5)
{
Proplftlb <- getchar(input$Proplftlabl,',')
Proplftcl <- getchar(input$Proplftclm, ', ')
Proprghtcl <- getchar(input$Proprghtclm, ', ')
Proprghtlb <- getchar(input$Proprghtlabl,',')
# Proprghtlb <- getchar(c(eval(parse(text = "Propmodel()$sm")),getchar(input$Proprghtlabl,',')),',')
forest(
Propmodel(), xlim = c(input$minPropxlim,input$maxPropxlim),
sortvar = unlist(Propmodel()[input$Propsortvar]) ,
rightcols = Proprghtcl,
rightlabs = Proprghtlb,
leftcols = Proplftcl,
leftlabs = Proplftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
ref = 0.5,
smlab = paste(input$Propsmlabforest,'\n (0.5)'),
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$PropcolFdiamond,
# col.diamond.lines = "black",
col.square = input$PropcolFStud,
#col.square.lines = 'grey60',
col.predict = input$PropcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$Propcolgap,'cm')
)
grid::grid.text(input$Proptitleforest, input$PropHtitleoffset, input$PropVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
dev.off()
}
)
output$downloadPropfunnelplot <- downloadHandler(
filename = function() {
paste(input$Propfunneltitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$PropHp ,width = input$PropWp, res = input$PropResp)
{
# funnel.meta(Propmodel())
funnel(Propmodel()$TE,Propmodel()$seTE,
main= input$Propfunneltitle, refline = 0.5,
# xlim = c(input$minPropxlimp,input$maxPropxlimp),
level=c(90, 95, 99), shade=c("white", "red", "orange"),
cex = input$Propfunnelcex, col = input$Propfunnelstudy ,
back = input$Propfunnelbg)
}
dev.off()
}
)
output$downloadPropDraperyplot <- downloadHandler(
filename = function() {
paste(input$PropDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$PropHd*2 ,width = input$PropWd*2, res = input$PropResd*2)
{
# drapery(
# Propmodel(), type = "pval", legend = T,
# labels = "studlab",
# xlim = c(input$minPropxlimd,input$maxPropxlimd),
# layout = 'linewidth',lwd.max = 2,
# main = input$PropDraperytitle
# )
drapery(
Propmodel(), type = "pval",
labels = "studlab",
main = input$PropDraperytitle,
pos.legend = 'topright',
xlim = c(0,1.5),
layout = 'linewidth'
# legend = T,
# xlim = c(input$minPropxlimd,input$maxPropxlimd),
# lwd.max = 2,
)
}
dev.off()
}
)
# data download:
output$exProp <- downloadHandler(
filename = function() {
paste('Proportion dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(PropData(),file)
}
)
# trim fill :
Proptrimfill <- reactive({
trimfill(Propmodel())
})
output$Proptrimfillmodel <- renderPrint(Proptrimfill())
observeEvent(c(input$PropW,input$PropH,input$PropRes),
{output$Proptrimfillforest <- renderPlot(
width = input$PropW,
height = input$PropH,
res = input$PropRes,
{
Proplftlb <- getchar(input$Proplftlabl,',')
Proplftcl <- getchar(input$Proplftclm, ', ')
Proprghtcl <- getchar(input$Proprghtclm, ', ')
Proprghtlb <- getchar(input$Proprghtlabl,',')
forest(
Proptrimfill(),
sortvar= unlist(Proptrimfill()[input$Propsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("Prop","95% CI"," Weight"),
rightcols = Proprghtcl,
rightlabs = Proprghtlb,
leftcols = Proplftcl,
leftlabs = Proplftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$PropcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$PropcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$PropcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$Proptitleforest, input$PropHtitleoffset, input$PropVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$PropWp,input$PropHp,input$PropResp),
{output$Proptrimfillfunnel <- renderPlot(
width = input$PropWp,
height = input$PropHp,
res = input$PropResp,
{funnel(
Proptrimfill()$TE,Proptrimfill()$seTE,
main= input$Propfunneltitle,
# refline = Propmodel()$TE.random,
# xlim = c(input$minPropxlimp,input$maxPropxlimp),
pch = ifelse(Proptrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$Propfunnelcex,
col = input$Propfunnelstudy ,
back = input$Propfunnelbg)
}
)}
)
observeEvent(c(input$PropWd,input$PropHd,input$PropResd),
{
output$Proptrimfilldrapery <- renderPlot(
width = input$PropWd,
height = input$PropHd,
res = input$PropResd,
{
drapery(
Proptrimfill(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minPropxlimd,input$maxPropxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$PropDraperytitle)
}
)}
)
}
# COR ----
{
CORData <- reactive({
if(is.null(input$file1)){
CORd <- gtdata('COR') # COR dataframe in global file
CORd$Study <- as.factor(CORd$Study)
CORd <- delrows(input$delr,CORd)
CORd <- delcols(input$delc,CORd)
return(CORd)
} else{
return(MyDat())
}
})
output$CORt <- renderTable({
chek <- function(n,h){
b <- 0
for (i in n) {
if(i %in% h){
b = b+1
} else {
b = b
}
}
return(b)
}
if(chek(CORreqcol,colnames(CORData())) == 2){
if(input$disp == "head") {
return(head( CORData()))
} else {return( CORData())
}
} else {'Error! Please revise the uploaded data for appropriate format'}
})
output$CORsummarydata <- renderPrint({
if(chek(CORreqcol,colnames(CORData())) == 2){
dataset <- CORData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
observeEvent(CORData(),
updateSelectInput(session,'CORsubgroup', selected = 'NULL',
choices = c('NULL', getsubgroupvar(CORData(),CORreqcol)))
)
# Meta object:
CORmodel <- reactive({
COR <- CORData()
if(input$CORsubgroup == 'NULL'){
x = eval(parse(text = 'NULL'))
} else{
x <- eval(parse(text = paste0('COR$',input$CORsubgroup)))
}
CORmeta <- meta::metacor(
cor = cor, n = n,
studlab = paste(Study),
byvar = x,
data = COR, sm = input$CORsm, backtransf = input$CORbackTfor,
comb.random = input$CORrandom, comb.fixed = input$CORfixed, prediction = T,
method.tau = input$CORmethodtau, hakn = TRUE
)
})
output$COR.model <- renderPrint({
summary(CORmodel())
})
output$CORpubBias <- renderPrint(
getbias(CORmodel())
)
output$CORbias <- renderUI({
g <- eggers.test(CORmodel())
df <- data.frame(
intercept <- c(round(g$intercept,3)),
`95% CI` <- c(paste0(round(g$llci,3),' - ' ,round(g$ulci,3))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(CORmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
CORData(),
updateSelectInput(session,'CORregfactor',
choices = c(getsubgroupvar(CORData(),CORreqcol)))
)
CORregmodel <- reactive({
req(input$CORregfactor)
a <- input$CORregfactor
b <- pastreg(a,input$CORmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = CORmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$COR.regmodel <- renderPrint({
req(input$CORregfactor)
summary(CORregmodel())
})
# Sensitivity analysis ----
output$CORbasicO <- renderPrint({
find.outliers(CORmodel())
})
CORsens <- reactive({
InfluenceAnalysis(x = CORmodel(),random = TRUE)
})
output$CORsens_sum <- renderPrint({
CORsens()
})
output$CORsens_Bplot <- renderUI({
output$CORsens_Bplot2 <- renderPlot({
x <- CORsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('CORsens_Bplot2')
})
output$CORsens_ForestI2 <- renderUI({
output$CORsens_ForestI22 <- renderPlot({
plot(CORsens()$ForestI2)
})
plotOutput('CORsens_ForestI22')
})
output$CORsens_ForestEffectsize <- renderUI({
output$CORsens_ForestEffectsize2 <- renderPlot({
plot(CORsens()$ForestEffectSize)
})
plotOutput('CORsens_ForestEffectsize2')
})
output$CORsens_InfluenceCharacteristics <- renderUI({
output$CORsens_InfluenceCharacteristics2 <- renderPlot({
plot(CORsens()$InfluenceCharacteristics)
})
plotOutput('CORsens_InfluenceCharacteristics2')
})
output$CORpcurve <- renderUI({
observeEvent(c(input$CORWc,input$CORHc,input$CORResc),{
output$CORpcurve2 <- renderPlot(
width = input$CORWc,
height =input$CORHc,
res = input$CORResc,
{
pcurve(CORmodel())
}
)
}
)
plotOutput('CORpcurve2')
})
output$downloadCORpcurveplot <- {downloadHandler(
filename = function() {
paste('COR Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$CORHc*2 ,width = input$CORWc*2, res = input$CORResc*2)
{
pcurve(CORmodel())
}
dev.off()
}
)}
CORmodel.rma <- reactive({
# rma(measure = 'MN', ni= n, mi= COR, sdi = sd, data = CORData(),
# method = CORmodel()$method.tau,
# test = "knha")
rma(yi = CORmodel()$TE,
sei = CORmodel()$seTE,
method = CORmodel()$method.tau,
test = "knha")
})
CORgosh <- reactive({
gosh(CORmodel.rma())
})
output$CORgosh_plot <- renderUI({
output$CORgosh_plot2 <- renderPlot({
plot(CORgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('CORgosh_plot2')
})
CORgoshdiagnostics <- reactive({
x <- gosh.diagnostics(CORgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$CORgosh_sum <- renderPrint({
CORgoshdiagnostics()
})
output$CORgoshdiag_plot <- renderUI({
output$CORgoshdiag_plot2 <- renderPlot({
plot(CORgoshdiagnostics())
})
plotOutput('CORgoshdiag_plot2')
})
# plots ----
observeEvent(
input$CORsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$CORsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'CORrghtlabl', value = y)}
)
# plots
output$CORforestplot <- renderUI({
observeEvent(c(input$CORW,input$CORH,input$CORRes),
output$CORforestplot2 <- renderPlot(
width = input$CORW,
height = input$CORH,
res = input$CORRes,
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
CORlftlb <- getchar(input$CORlftlabl,',')
CORlftcl <- getchar(input$CORlftclm, ', ')
CORrghtcl <- getchar(input$CORrghtclm, ', ')
CORrghtlb <- getchar(input$CORrghtlabl,',')
# CORrghtlb <- getchar(c(eval(parse(text = "CORmodel()$sm")),getchar(input$CORrghtlabl,',')),',')
forest(
CORmodel(), xlim = c(input$minCORxlim,input$maxCORxlim),
sortvar= unlist(CORmodel()[input$CORsortvar]),
rightcols = CORrghtcl,
rightlabs = CORrghtlb,
leftcols = CORlftcl,
leftlabs = CORlftlb,
# leftcols= c('studlab','cor','n'),
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$CORcolFdiamond,
# col.diamond.lines = "black",
col.square = input$CORcolFStud,
#col.square.lines = 'grey60',
col.predict = input$CORcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$CORcolgap,'cm')
)
grid::grid.text(input$CORtitleforest, input$CORHtitleoffset, input$CORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)
)
plotOutput('CORforestplot2',width= paste0(input$CORW,'px'), height = paste0(input$CORH,'px'))
})
output$CORfunnelplot <- renderUI({
observeEvent(c(input$CORWp,input$CORHp,input$CORResp),
output$CORfunnelplot2 <- renderPlot(
width = input$CORWp,
height = input$CORHp,
res = input$CORResp,
funnel(
CORmodel()$TE, CORmodel()$seTE, level=c(90, 95, 99),
main= input$CORfunneltitle, xlim = c(input$minCORxlimp,input$maxCORxlimp),
shade=c("white", "red", "orange"),
cex = input$CORfunnelcex, col = input$CORfunnelstudy ,back = input$CORfunnelbg)
)
)
plotOutput('CORfunnelplot2',width= paste0(input$CORWp,'px'), height = paste0(input$CORHp,'px'))
})
output$CORdraperyplot <- renderUI({
observeEvent(c(input$CORWd,input$CORHd,input$CORResd),{
output$CORdraperyplot2 <- renderPlot(
width = input$CORWd,
height = input$CORHd,
res = input$CORResd,
{drapery(
CORmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minCORxlimd,input$maxCORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$CORDraperytitle
)
}
)}
)
plotOutput('CORdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadCORforestplot <- downloadHandler(
filename = function() {
paste(input$CORtitleforest, "png", sep = '.')},
content = function(file) {
png(file,height = input$CORH*1.5 ,width = input$CORW*1.5, res = input$CORRes*1.5)
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
CORlftlb <- getchar(input$CORlftlabl,',')
CORlftcl <- getchar(input$CORlftclm, ', ')
CORrghtcl <- getchar(input$CORrghtclm, ', ')
CORrghtlb <- getchar(input$CORrghtlabl,',')
# CORrghtlb <- getchar(c(eval(parse(text = "CORmodel()$sm")),getchar(input$CORrghtlabl,',')),',')
forest(
CORmodel(), xlim = c(input$minCORxlim,input$maxCORxlim),
sortvar= unlist(CORmodel()[input$CORsortvar]),
rightcols = CORrghtcl,
rightlabs = CORrghtlb,
leftcols = CORlftcl,
leftlabs = CORlftlb,
# leftcols= c('studlab','cor','n'),
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$CORcolFdiamond,
# col.diamond.lines = "black",
col.square = input$CORcolFStud,
#col.square.lines = 'grey60',
col.predict = input$CORcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$CORcolgap,'cm')
)
grid::grid.text(input$CORtitleforest, input$CORHtitleoffset, input$CORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
dev.off()
}
)
output$downloadCORfunnelplot <- downloadHandler(
filename = function() {
paste(input$CORfunneltitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$CORHp ,width = input$CORWp, res = input$CORResp)
{
funnel(CORmodel()$TE,CORmodel()$seTE,
main= input$CORfunneltitle, xlim = c(input$minCORxlimp,input$maxCORxlimp),
level=c(90, 95, 99), shade=c("white", "red", "orange"),
cex = input$CORfunnelcex, col = input$CORfunnelstudy ,back = input$CORfunnelbg)
}
dev.off()
}
)
output$downloadCORDraperyplot <- downloadHandler(
filename = function() {
paste(input$CORDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$CORHd*2 ,width = input$CORWd*2, res = input$CORResd*2)
{
drapery(
CORmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minCORxlimd,input$maxCORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$CORDraperytitle
)
}
dev.off()
}
)
# data download:
output$exCOR <- downloadHandler(
filename = function() {
paste('Correlation dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(CORData(),file)
}
)
# trim fill :
CORtrimfill <- reactive({
trimfill(CORmodel())
})
output$CORtrimfillmodel <- renderPrint(CORtrimfill())
observeEvent(c(input$CORW,input$CORH,input$CORRes),
{output$CORtrimfillforest <- renderPlot(
width = input$CORW,
height = input$CORH,
res = input$CORRes,
{
CORlftlb <- getchar(input$CORlftlabl,',')
CORlftcl <- getchar(input$CORlftclm, ', ')
CORrghtcl <- getchar(input$CORrghtclm, ', ')
CORrghtlb <- getchar(input$CORrghtlabl,',')
forest(
CORtrimfill(),
sortvar= unlist(CORtrimfill()[input$CORsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("COR","95% CI"," Weight"),
rightcols = CORrghtcl,
rightlabs = CORrghtlb,
leftcols = CORlftcl,
leftlabs = CORlftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$CORcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$CORcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$CORcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$CORtitleforest, input$CORHtitleoffset, input$CORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$CORWp,input$CORHp,input$CORResp),
{output$CORtrimfillfunnel <- renderPlot(
width = input$CORWp,
height = input$CORHp,
res = input$CORResp,
{funnel(
CORtrimfill()$TE,CORtrimfill()$seTE,
main= input$CORfunneltitle,
# refline = CORmodel()$TE.random,
# xlim = c(input$minCORxlimp,input$maxCORxlimp),
pch = ifelse(CORtrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$CORfunnelcex,
col = input$CORfunnelstudy ,
back = input$CORfunnelbg)
}
)}
)
observeEvent(c(input$CORWd,input$CORHd,input$CORResd),{
output$CORtrimfilldrapery <- renderPlot(
width = input$CORWd,
height = input$CORHd,
res = input$CORResd,
{
drapery(
CORtrimfill(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minCORxlimd,input$maxCORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$CORDraperytitle)
}
)}
)
}
# OR ----
{
{
# metaobject <- reactive({
# OR <- ORData()
# OR$mean.e <- as.numeric(OR$mean.e)
# OR$n.e <- as.numeric(OR$n.e)
# OR$sd.e <- as.numeric(OR$sd.e)
# OR$mean.c <- as.numeric(OR$mean.c)
# OR$n.c <- as.numeric(OR$n.c)
# OR$sd.c <- as.numeric(OR$sd.c)
# model <- meta::metacont(
# mean.e = mean.e,
# sd.e = sd.e,
# n.e= n.e,
# mean.c= mean.c,
# sd.c = sd.c,
# n.c = n.c,
# data = OR,
# sm = 'OR',
# comb.random = T, comb.fixed = F,
# prediction = T,
# studlab = paste(Study),
# method.tau = input$methodtau, method.smd = input$methodsmd,
# label.e = 'Sicklers', label.c = 'Non-Sicklers',
# )
# return(model)
# })
}
ORData <- reactive({
if(is.null(input$file1)){
OR <- gtdata('OR')
OR$Study <- as.factor(OR$Study)
OR <- delrows(input$delr,OR)
OR <- delcols(input$delc,OR)
return(OR)
} else {return(MyDat())}
})
output$ORt <- renderTable({
chek <- function(n,h){
b <- 0
for (i in n) {
if(i %in% h){
b = b+1
} else {
b = b
}
}
return(b)
}
if(chek(ORreqcol,colnames(ORData())) == 4){
if(input$disp == "head") {
return(head( ORData()))
} else {return( ORData())
}
} else {'Error! Please revise the uploaded data for appropriate format'}
})
output$ORsummarydata <- renderPrint({
if(chek(ORreqcol,colnames(ORData())) == 4){
dataset <- ORData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
# subgroup analysis
observeEvent(ORData(),
updateSelectInput(session,'ORsubgroup', selected = 'NULL',
choices = c('NULL', getsubgroupvar(ORData(),ORreqcol)))
)
# Meta object:
ORmodel <- reactive({
OR <- ORData()
if(input$ORsubgroup == 'NULL'){
x = eval(parse(text = 'NULL'))
} else{
x <- eval(parse(text = paste0('OR$',input$ORsubgroup)))
}
ORmeta <- meta::metabin(
event.e = event.e, n.e = n.e,
event.c = event.c, n.c = n.c,
studlab = paste(Study),
byvar = x,
data = OR, sm = 'OR',
comb.random = input$ORrandom, comb.fixed = input$ORfixed, prediction = T,
method.tau = input$ORmethodtau, hakn = TRUE, incr = 0.1
)
})
output$OR.model <- renderPrint({
summary(ORmodel())
})
output$ORpubBias <- renderPrint({
# meta::metabias.meta(ORmodel(), k.min = 4)
getbias(ORmodel())
})
output$ORbias <- renderUI({
g <- eggers.test(ORmodel())
df <- data.frame(
intercept <- c(round(g$intercept,3)),
`95% CI` <- c(paste0(round(g$llci,3),' - ' ,round(g$ulci,3))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(ORmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
ORData(),
updateSelectInput(session,'ORregfactor',
choices = c(getsubgroupvar(ORData(),ORreqcol)))
)
ORregmodel <- reactive({
req(input$ORregfactor)
a <- input$ORregfactor
b <- pastreg(a,input$ORmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = ORmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$OR.regmodel <- renderPrint({
req(input$ORregfactor)
summary(ORregmodel())
})
# Sensitivity analysis ----
output$ORbasicO <- renderPrint({
find.outliers(ORmodel())
})
ORsens <- reactive({
InfluenceAnalysis(x = ORmodel(),random = TRUE)
})
output$ORsens_sum <- renderPrint({
ORsens()
})
output$ORsens_Bplot <- renderUI({
output$ORsens_Bplot2 <- renderPlot({
x <- ORsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('ORsens_Bplot2')
})
output$ORsens_ForestI2 <- renderUI({
output$ORsens_ForestI22 <- renderPlot({
plot(ORsens()$ForestI2)
})
plotOutput('ORsens_ForestI22')
})
output$ORsens_ForestEffectsize <- renderUI({
output$ORsens_ForestEffectsize2 <- renderPlot({
plot(ORsens()$ForestEffectSize)
})
plotOutput('ORsens_ForestEffectsize2')
})
output$ORsens_InfluenceCharacteristics <- renderUI({
output$ORsens_InfluenceCharacteristics2 <- renderPlot({
plot(ORsens()$InfluenceCharacteristics)
})
plotOutput('ORsens_InfluenceCharacteristics2')
})
output$ORpcurve <- renderUI({
observeEvent(c(input$ORWc,input$ORHc,input$ORResc),{
output$ORpcurve2 <- renderPlot(
width = input$ORWc,
height =input$ORHc,
res = input$ORResc,
{
pcurve(ORmodel())
}
)
}
)
plotOutput('ORpcurve2')
})
output$downloadORpcurveplot <- {downloadHandler(
filename = function() {
paste('OR Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$ORHc*2 ,width = input$ORWc*2, res = input$ORResc*2)
{
pcurve(ORmodel())
}
dev.off()
}
)}
ORmodel.rma <- reactive({
rma(yi = ORmodel()$TE,
sei = ORmodel()$seTE,
method = ORmodel()$method.tau,
test = "knha")
})
ORgosh <- reactive({
gosh(ORmodel.rma())
})
output$ORgosh_plot <- renderUI({
output$ORgosh_plot2 <- renderPlot({
plot(ORgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('ORgosh_plot2')
})
ORgoshdiagnostics <- reactive({
x <- gosh.diagnostics(ORgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$ORgosh_sum <- renderPrint({
ORgoshdiagnostics()
})
output$ORgoshdiag_plot <- renderUI({
output$ORgoshdiag_plot2 <- renderPlot({
plot(ORgoshdiagnostics())
})
plotOutput('ORgoshdiag_plot2')
})
# plots ----
observeEvent(
input$ORsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$ORsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'ORrghtlabl', value = y)}
)
# plots
output$ORforestplot <- renderUI({
observeEvent(c(input$ORW,input$ORH,input$ORRes),
{output$ORforestplot2 <- renderPlot(
width = input$ORW,
height = input$ORH,
res = input$ORRes,
{{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
ORlftlb <- getchar(input$ORlftlabl,',')
ORlftcl <- getchar(input$ORlftclm, ', ')
ORrghtcl <- getchar(input$ORrghtclm, ', ')
# ORrghtlb <- getchar(input$ORrghtlabl,',')
ORrghtlb <- getchar(c(eval(parse(text = "ORmodel()$sm")),getchar(input$ORrghtlabl,',')),',')
forest(
ORmodel(), ref = 1,
sortvar= unlist(ORmodel()[input$ORsortvar]),
rightcols = ORrghtcl,
rightlabs = ORrghtlb,
leftcols = ORlftcl,
leftlabs = ORlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$ORcolFdiamond,
# col.diamond.lines = "black",
col.square = input$ORcolFStud,
#col.square.lines = 'grey60',
col.predict = input$ORcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$ORtitleforest, input$ORHtitleoffset, input$ORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}}
)}
)
plotOutput('ORforestplot2',width= paste0(input$ORW,'px'), height = paste0(input$ORH,'px'))
})
output$ORfunnelplot <- renderUI({
observeEvent(c(input$ORWp,input$ORHp,input$ORResp),
{output$ORfunnelplot2 <- renderPlot(
width = input$ORWp,
height = input$ORHp,
res = input$ORResp,
{funnel(
ORmodel()$TE, ORmodel()$seTE, level=c(90, 95, 99),
main= input$ORtitlefunnel, xlim = c(input$minORxlimp,input$maxORxlimp),
shade=c("white", "red", "orange"),
cex = input$ORfunnelcex, col = input$ORfunnelstudy ,back = input$ORfunnelbg)}
)}
)
plotOutput('ORfunnelplot2',width= paste0(input$ORWp,'px'), height = paste0(input$ORHp,'px'))
})
output$ORdraperyplot <- renderUI({
observeEvent(c(input$ORWd,input$ORHd,input$ORResd),{
output$ORdraperyplot2 <- renderPlot(
width = input$ORWd,
height = input$ORHd,
res = input$ORResd,
{drapery(
ORmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minORxlimd,input$maxORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$ORDraperytitle
)
}
)}
)
plotOutput('ORdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadORforestplot <- downloadHandler(
filename = function() {
paste(input$ORtitleforest, "png", sep = '.')},
content = function(file) {
png(file,height = input$ORH*1.5 ,width = input$ORW*1.5, res = input$ORRes*1.5)
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
ORlftlb <- getchar(input$ORlftlabl,',')
ORlftcl <- getchar(input$ORlftclm, ', ')
ORrghtcl <- getchar(input$ORrghtclm, ', ')
# ORrghtlb <- getchar(input$ORrghtlabl,',')
ORrghtlb <- getchar(c(eval(parse(text = "ORmodel()$sm")),getchar(input$ORrghtlabl,',')),',')
forest(
ORmodel(),
sortvar= unlist(ORmodel()[input$ORsortvar]),
rightcols = ORrghtcl,
rightlabs = ORrghtlb,
leftcols = ORlftcl,
leftlabs = ORlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$ORcolFdiamond,
# col.diamond.lines = "black",
col.square = input$ORcolFStud,
#col.square.lines = 'grey60',
col.predict = input$ORcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$ORtitleforest, input$ORHtitleoffset, input$ORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
dev.off()
}
)
output$downloadORfunnelplot <- downloadHandler(
filename = function() {
paste(input$ORtitlefunnel, "png", sep = '.')
},
content = function(file) {
png(file,height = input$ORHp ,width = input$ORWp, res = input$ORResp)
funnel(
ORmodel()$TE, ORmodel()$seTE, level=c(90, 95, 99),
main= input$ORfunneltitle, xlim = c(input$minORxlimp,input$maxORxlimp),
shade=c("white", "red", "orange"),
cex = input$ORfunnelcex, col = input$ORfunnelstudy ,back = input$ORfunnelbg)
dev.off()
}
)
output$downloadORDraperyplot <- downloadHandler(
filename = function() {
paste(input$ORDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$ORHd*2 ,width = input$ORWd*2, res = input$ORResd*2)
{
drapery(
ORmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minORxlimd,input$maxORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$ORDraperytitle
)
}
dev.off()
}
)
# data download:
output$exOR <- downloadHandler(
filename = function() {
paste('OR dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(ORData(),file)
}
)
# trim fill :
ORtrimfill <- reactive({
trimfill(ORmodel())
})
output$ORtrimfillmodel <- renderPrint(ORtrimfill())
observeEvent(c(input$ORW,input$ORH,input$ORRes),
{output$ORtrimfillforest <- renderPlot(
width = input$ORW,
height = input$ORH,
res = input$ORRes,
{
ORlftlb <- getchar(input$ORlftlabl,',')
ORlftcl <- getchar(input$ORlftclm, ', ')
ORrghtcl <- getchar(input$ORrghtclm, ', ')
ORrghtlb <- getchar(input$ORrghtlabl,',')
forest(
ORtrimfill(),
sortvar= unlist(ORtrimfill()[input$ORsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("OR","95% CI"," Weight"),
rightcols = ORrghtcl,
rightlabs = ORrghtlb,
leftcols = ORlftcl,
leftlabs = ORlftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$ORcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$ORcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$ORcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$ORtitleforest, input$ORHtitleoffset, input$ORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$ORWp,input$ORHp,input$ORResp),
{output$ORtrimfillfunnel <- renderPlot(
width = input$ORWp,
height = input$ORHp,
res = input$ORResp,
{funnel(
ORtrimfill()$TE,ORtrimfill()$seTE,
main= input$ORfunneltitle,
# refline = ORmodel()$TE.random,
# xlim = c(input$minORxlimp,input$maxORxlimp),
pch = ifelse(ORtrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$ORfunnelcex,
col = input$ORfunnelstudy ,
back = input$ORfunnelbg)
}
)}
)
observeEvent(c(input$ORWd,input$ORHd,input$ORResd),{
output$ORtrimfilldrapery <- renderPlot(
width = input$ORWd,
height = input$ORHd,
res = input$ORResd,
{
drapery(
ORtrimfill(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minORxlimd,input$maxORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$ORDraperytitle)
}
)}
)
}
observeEvent(input$logout,{
logout()
})
}
# )
Ibrahimhassan94/MAAS documentation built on Feb. 24, 2022, 8:14 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.
server <-
# auth0::auth0_server(
function(input, output, session) {
# bs_themer()
# original code: Don't touch or edit
# alert("Be varful")
output$whatsnew <- renderUI(includeHTML("./version.html"))
# validate input sheet and skip: ----
positivesheet <- reactive({
positive <- input$sheet >= 1
shinyFeedback::feedbackWarning("sheet",!positive, "Please select an integer number >= 1")
})
output$positivesheet <- renderText(positivesheet())
positiveskip <- reactive({
positive <- input$Skip >= 0
shinyFeedback::feedbackWarning("Skip",!positive, "Please select an integer number >= 0")
})
output$positiveskip <- renderText(positiveskip())
# Data import: ----
MyDat <- reactive({
req(input$sheet >= 1)
req(input$Skip >= 0)
req(input$file1)
# req(input$delc)
# req(input$delr)
v <- input$file1$datapath
u <- file_ext(v)
df <- switch(u,
#csv = utils::read.csv(v, header = input$header,sep = input$sep,quote = input$quote),
csv = vroom::vroom(v,n_max = input$nmax, col_names = input$Colname,
skip = input$Skip, delim = input$sep, quote = input$quote),
tsv = vroom::vroom(v, delim = "\t"),
xlsx = readxl::read_excel(v, n_max = input$nmax, sheet = input$sheet,
col_names = input$Colname,skip = input$Skip),
validate("Invalid file; Please upload a .csv or .tsv or .xls /.xlsx file")
)
# df <- as.data.frame(df)
df<- delrows(input$delr,df)
df <- delcols(input$delc,df)
{
# df <- if(u == 'csv'){
# # csv
# {
# utils::read.csv(v,
# header = input$header,
# sep = input$sep,
# quote = input$quote)
# }
# } else {
# # excel
# {
# readxl::read_excel(v, n_max = input$nmax,
# sheet = input$sheet,
# col_names = input$Colname,
# skip = input$Skip)
# }
# }
}
return(df)
})
# observeEvent(c(MyDat()),{
# updateTextAreaInput(session,'cols', value = paste(' ',colnames(MyDat()),' '))
# })
# update number of columns and rows to delete
observeEvent(input$file1,
{
updateSelectInput(session,'delr', choices = c(1:nrow(MyDat())))
updateSelectInput(session,'delc', choices = c(1:ncol(MyDat())))
}
)
output$cleaneddata <- renderTable({
if(is.null(input$file1)){
'No data has been imported'
} else {
if(input$disp == "head") {
head(MyDat())
} else {
MyDat()
}
}
})
# Mean ----
{
# data, summary, table ----
MeanData <- reactive({
if(is.null(input$file1)){
meand <- gtdata('Mean') # Mean dataframe in global file
meand$Study <- as.factor(meand$Study)
meand <- delrows(input$delr,meand)
meand <- delcols(input$delc,meand)
return(meand)
} else {return(MyDat())}
})
output$Meant <- renderTable({
chek <- function(n,h){
b <- 0
for (i in n) {
if(i %in% h){
b = b+1
} else {
b = b
}
}
return(b)
}
if(chek(Meanreqcol,colnames(MeanData())) == 3){
if(input$disp == "head") {
return(head(MeanData()))
} else {return( MeanData())
}
} else {'Error! Please revise the uploaded data for appropriate format'}
})
output$Meansummarydata <- renderPrint({
if(chek(Meanreqcol,colnames(MeanData())) == 3){
dataset <- MeanData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
observeEvent(MeanData(),
updateSelectInput(session,'MEANsubgroup', selected = 'NULL', choices = c('NULL', getsubgroupvar(MeanData(),Meanreqcol)))
)
# Meta object, summary model, publication bias ----
Meanmodel <- reactive({
Mean <- MeanData()
# if(input$MEANsubgroup == 'NULL'){
# x = eval(parse(text = 'NULL'))
# } else{
# x <- eval(parse(text = paste0('Mean','$',input$MEANsubgroup)))
# }
meta::metamean(
mean = mean, sd = sd, n = n,
studlab = paste(Study), #byvar = x,
data = Mean, sm = input$MEANsm, backtransf = input$MEANbackTfor,
comb.random = input$Meanrandom, comb.fixed = input$Meanfixed, prediction = T,
method.tau = input$MEANmethodtau, hakn = TRUE
)
})
output$Mean.model <- renderPrint({
summary(Meanmodel())
})
output$MEANpubBias <- renderPrint({
getbias(Meanmodel())
})
output$Meanbias <- renderUI({
g <- eggers.test(Meanmodel())
df <- data.frame(
intercept <- c(round(g$intercept,2)),
`95% CI` <- c(paste0(round(g$llci,2),' - ' ,round(g$ulci,2))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
# column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(Meanmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
MeanData(),
updateSelectInput(session,'MEANregfactor',
choices = c(getsubgroupvar(MeanData(),Meanreqcol)))
)
Meanregmodel <- reactive({
req(input$MEANregfactor)
a <- input$MEANregfactor
b <- pastreg(a,input$Meanmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = Meanmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$Mean.regmodel <- renderPrint({
req(input$MEANregfactor)
Meanregmodel()
})
# sensetvity analysis ----
output$MEANbasicO <- renderPrint({
find.outliers(Meanmodel())
})
MEANsens <- reactive({
InfluenceAnalysis(x = Meanmodel(),random = TRUE)
})
output$MEANsens_sum <- renderPrint({
MEANsens()
})
output$MEANsens_Bplot <- renderUI({
output$MEANsens_Bplot2 <- renderPlot({
x <- MEANsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('MEANsens_Bplot2')
})
output$MEANsens_ForestI2 <- renderUI({
output$MEANsens_ForestI22 <- renderPlot({
plot(MEANsens()$ForestI2)
})
plotOutput('MEANsens_ForestI22')
})
output$MEANsens_ForestEffectsize <- renderUI({
output$MEANsens_ForestEffectsize2 <- renderPlot({
plot(MEANsens()$ForestEffectSize)
})
plotOutput('MEANsens_ForestEffectsize2')
})
output$MEANsens_InfluenceCharacteristics <- renderUI({
output$MEANsens_InfluenceCharacteristics2 <- renderPlot({
plot(MEANsens()$InfluenceCharacteristics)
})
plotOutput('MEANsens_InfluenceCharacteristics2')
})
output$MEANpcurve <- renderUI({
observeEvent(c(input$MEANWc,input$MEANHc,input$MEANResc),{
output$MEANpcurve2 <- renderPlot(
width = input$MEANWc,
height =input$MEANHc,
res = input$MEANResc,
{
pcurve(Meanmodel())
}
)
}
)
plotOutput('MEANpcurve2')
})
output$downloadMEANpcurveplot <- {downloadHandler(
filename = function() {
paste('Mean Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$MEANHc*2 ,width = input$MEANWc*2, res = input$MEANResc*2)
{
pcurve(Meanmodel())
}
dev.off()
}
)}
Meanmodel.rma <- reactive({
# rma(measure = 'MN', ni= n, mi= mean, sdi = sd, data = MeanData(),
# method = Meanmodel()$method.tau,
# test = "knha")
rma(yi = Meanmodel()$TE,
sei = Meanmodel()$seTE,
method = Meanmodel()$method.tau,
test = "knha")
})
MEANgosh <- reactive({
gosh(Meanmodel.rma())
})
output$MEANgosh_plot <- renderUI({
output$MEANgosh_plot2 <- renderPlot({
plot(MEANgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('MEANgosh_plot2')
})
MEANgoshdiagnostics <- reactive({
x <- gosh.diagnostics(MEANgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$MEANgosh_sum <- renderPrint({
MEANgoshdiagnostics()
})
output$MEANgoshdiag_plot <- renderUI({
output$MEANgoshdiag_plot2 <- renderPlot({
plot(MEANgoshdiagnostics())
})
plotOutput('MEANgoshdiag_plot2')
})
# plots ----
observeEvent(
input$MEANsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$MEANsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'MEANrghtlabl', value = y)}
)
output$MEANforestplot <- renderUI({
observeEvent(c(input$MEANW,input$MEANH,input$MEANRes),
{
output$MEANforestplot2 <- renderPlot(
width = input$MEANW,
height = input$MEANH,
res = input$MEANRes,
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
#x <- Meanmodel()[names(Meanmodel()) == paste(input$MEANsortvar)]
MEANlftlb <- getchar(input$MEANlftlabl,',')
MEANlftcl <- getchar(input$MEANlftclm, ', ')
MEANrghtcl <- getchar(input$MEANrghtclm, ', ')
MEANrghtlb <- getchar(input$MEANrghtlabl,',')
# MEANrghtlb <- getchar(c(eval(parse(text = "Meanmodel()$sm")),getchar(input$MEANrghtlabl,',')),',')
forest.meta(
Meanmodel(), xlim = c(input$minMEANxlim,input$maxMEANxlim),
sortvar = unlist(Meanmodel()[input$MEANsortvar]) ,
rightcols = MEANrghtcl,
rightlabs = MEANrghtlb,
leftcols = MEANlftcl,
leftlabs = MEANlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$MEANcolFdiamond,
# col.diamond.lines = "black",
col.square = input$MEANcolFStud,
#col.square.lines = 'grey60',
col.predict = input$MEANcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$MEANcolgap,'cm')
)
grid::grid.text(input$MEANtitleforest, input$MEANHtitleoffset, input$MEANVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
plotOutput('MEANforestplot2',width= paste0(input$MEANW,'px'), height = paste0(input$MEANH,'px'))
})
output$MEANfunnelplot <- renderUI({
observeEvent(c(input$MEANWp,input$MEANHp,input$MEANResp),
{output$MEANfunnelplot2 <- renderPlot(
width = input$MEANWp,
height = input$MEANHp,
res = input$MEANResp,
{funnel(
Meanmodel()$TE, Meanmodel()$seTE,
level=c(90, 95, 99),
refline = Meanmodel()$TE.random,
main= input$MEANfunneltitle,
xlim = c(min(Meanmodel()$mean),max(Meanmodel()$mean)),
shade=c("white", "red", "orange"),
cex = input$MEANfunnelcex,
col = input$MEANfunnelstudy ,
back = input$MEANfunnelbg)}
)}
)
plotOutput('MEANfunnelplot2',width= paste0(input$MEANWp,'px'), height = paste0(input$MEANHp,'px'))
})
output$MEANdraperyplot <- renderUI({
observeEvent(c(input$MEANWd,input$MEANHd,input$MEANResd),{
output$MEANdraperyplot2 <- renderPlot(
width = input$MEANWd,
height = input$MEANHd,
res = input$MEANResd,
{drapery(
Meanmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minMEANxlimd,input$maxMEANxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$MEANDraperytitle
)
}
)}
)
plotOutput('MEANdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadMEANforestplot <- {downloadHandler(
filename = function() {
paste(input$MEANtitleforest, "png", sep = '.')
},
content = function(file) {
png(file,height = input$MEANH*1.5 ,width = input$MEANW*1.5, res = input$MEANRes*1.5)
{
{
MEANlftlb <- getchar(input$MEANlftlabl,',')
MEANlftcl <- getchar(input$MEANlftclm, ', ')
MEANrghtcl <- getchar(input$MEANrghtclm, ', ')
MEANrghtlb <- getchar(input$MEANrghtlabl,',')
# MEANrghtlb <- getchar(c(eval(parse(text = "Meanmodel()$sm")),getchar(input$MEANrghtlabl,',')),',')
forest(
Meanmodel(), xlim = c(input$minMEANxlim,input$maxMEANxlim),
sortvar = unlist(Meanmodel()[input$MEANsortvar]) ,
rightcols = MEANrghtcl,
rightlabs = MEANrghtlb,
leftcols = MEANlftcl,
leftlabs = MEANlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$MEANcolFdiamond,
# col.diamond.lines = "black",
col.square = input$MEANcolFStud,
#col.square.lines = 'grey60',
col.predict = input$MEANcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$MEANcolgap,'cm')
)
grid::grid.text(input$MEANtitleforest, input$MEANHtitleoffset, input$MEANVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
}
dev.off()
}
)}
output$downloadMEANfunnelplot <- {downloadHandler(
filename = function() {
paste( input$MEANfunneltitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$MEANHp ,width = input$MEANWp, res = input$MEANResp)
{
funnel(
Meanmodel()$TE, Meanmodel()$seTE, level=c(90, 95, 99),
main= input$MEANfunneltitle, xlim = c(input$minMEANxlimp,input$maxMEANxlimp),
shade=c("white", "red", "orange"),
cex = input$MEANfunnelcex, col = input$MEANfunnelstudy ,back = input$MEANfunnelbg)
}
dev.off()
}
)}
output$downloadMEANDraperyplot <- {downloadHandler(
filename = function() {
paste(input$MEANDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$MEANHd*2 ,width = input$MEANWd*2, res = input$MEANResd*2)
{
drapery(
Meanmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minMEANxlimd,input$maxMEANxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$MEANDraperytitle
)
}
dev.off()
}
)}
# data download:
output$exMEAN <- {downloadHandler(
filename = function() {
paste('Mean dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(MeanData(),file)
}
)}
# trim fill :
MEANtrimfill <- reactive({
x <- trimfill(Meanmodel())
x$sd <- sdtrimfill(Meanmodel(),x)
x$mean <- meantrimfill(Meanmodel(),x)
return(x)
})
output$MEANtrimfillmodel <- renderPrint(MEANtrimfill())
observeEvent(c(input$MEANW,input$MEANH,input$MEANRes),
{output$MEANtrimfillforest <- renderPlot(
width = input$MEANW,
height = input$MEANH,
res = input$MEANRes,
{
MEANlftlb <- getchar(input$MEANlftlabl,',')
MEANlftcl <- getchar(input$MEANlftclm, ', ')
MEANrghtcl <- getchar(input$MEANrghtclm, ', ')
MEANrghtlb <- getchar(input$MEANrghtlabl,',')
# MEANrghtlb <- getchar(c(eval(parse(text = "MEANmodel()$sm")),getchar(input$MEANrghtlabl,',')),',')
forest(
MEANtrimfill(), xlim = c(input$minMEANxlim,input$maxMEANxlim),
sortvar = unlist(MEANtrimfill()[input$MEANsortvar]),
rightcols = MEANrghtcl,
rightlabs = MEANrghtlb,
leftcols = MEANlftcl,
leftlabs = MEANlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$MEANcolFdiamond,
# col.diamond.lines = "black",
col.square = input$MEANcolFStud,
#col.square.lines = 'grey60',
col.predict = input$MEANcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$MEANcolgap,'cm')
)
grid::grid.text(input$MEANtitleforest, input$MEANHtitleoffset, input$MEANVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$MEANWp,input$MEANHp,input$MEANResp),
{
output$MEANtrimfillfunnel <- renderPlot(
width = input$MEANWp,
height = input$MEANHp,
res = input$MEANResp,
funnel(
MEANtrimfill()$TE,MEANtrimfill()$seTE,
main= input$MEANfunneltitle,
xlim = c(min(MEANtrimfill()$mean),max(MEANtrimfill()$mean)),
refline = MEANtrimfill()$TE.random,
pch = ifelse(MEANtrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$MEANfunnelcex,
col = input$MEANfunnelstudy ,
back = input$MEANfunnelbg)
)
}
)
observeEvent(c(input$MEANWd,input$MEANHd,input$MEANResd),
{
output$MEANtrimfilldrapery <- renderPlot(
width = input$MEANWd,
height = input$MEANHd,
res = input$MEANResd,
{drapery(
MEANtrimfill(), type = "pval", legend = T,
labels = "studlab",
# xlim = c(min(MEANtrimfill()$mean),max(MEANtrimfill()$mean)),
xlim = c(input$minMEANxlimd,input$maxMEANxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$MEANDraperytitle
)
}
)
}
)
}
# SMD ----
{
{
# metaobject <- reactive({
# mg <- SMDData()
# mg$mean.e <- as.numeric(mg$mean.e)
# mg$n.e <- as.numeric(mg$n.e)
# mg$sd.e <- as.numeric(mg$sd.e)
# mg$mean.c <- as.numeric(mg$mean.c)
# mg$n.c <- as.numeric(mg$n.c)
# mg$sd.c <- as.numeric(mg$sd.c)
# model <- meta::metacont(
# mean.e = mean.e,
# sd.e = sd.e,
# n.e= n.e,
# mean.c= mean.c,
# sd.c = sd.c,
# n.c = n.c,
# data = mg,
# sm = 'SMD',
# comb.random = T, comb.fixed = F,
# prediction = T,
# studlab = paste(Study),
# method.tau = input$methodtau, method.smd = input$methodsmd,
# label.e = 'Sicklers', label.c = 'Non-Sicklers',
# )
# return(model)
# })
}
SMDData <- reactive({
if(is.null(input$file1)){
SMD <- gtdata('SMD')
SMD$Study <- as.factor(SMD$Study)
SMD <- delrows(input$delr,SMD)
SMD <- delcols(input$delc,SMD)
return(SMD)
} else {
MyDat()
}
})
output$SMDt <- renderTable({
if(chek(SMDreqcol,colnames(SMDData())) == 6){
if(input$disp == "head") {
return(head(SMDData()))
} else {
return(SMDData())
}
} else {
'Error! Please revise the uploaded data for appropriate format'
}
#SMDData()
})
output$SMDsummarydata <- renderPrint({
if(chek(SMDreqcol,colnames(SMDData())) == 6){
dataset <- SMDData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
# subgroup variables:
observeEvent(SMDData(),
updateSelectInput(session,'SMDsubgroup', selected = 'NULL',
choices = c('NULL', getsubgroupvar(SMDData(),SMDreqcol)))
)
SMDmodel <- reactive({
SMD <- SMDData()
if(input$SMDsubgroup == 'NULL'){
x = eval(parse(text = 'NULL'))
} else{
x <- eval(parse(text = paste0('SMD$',input$SMDsubgroup)))
}
SMD$mean.e <- as.numeric(SMD$mean.e)
SMD$n.e <- as.numeric(SMD$n.e)
SMD$sd.e <- as.numeric(SMD$sd.e)
SMD$mean.c <- as.numeric(SMD$mean.c)
SMD$n.c <- as.numeric(SMD$n.c)
SMD$sd.c <- as.numeric(SMD$sd.c)
model <- meta::metacont(
mean.e = mean.e, sd.e = sd.e, n.e= n.e,
mean.c= mean.c, sd.c = sd.c, n.c = n.c,
data = SMD, sm = input$SMDsm, byvar = x,
comb.random = input$SMDrandom, comb.fixed = input$SMDfixed, prediction = T,
studlab = paste(Study), label.e = input$SMDintervention ,
label.c = input$SMDcontrol,
method.tau = input$SMDmethodtau, method.smd = input$SMDmethodsmd)
})
output$SMD.model <- renderPrint({
summary(SMDmodel())
})
output$SMDpubBias <- renderPrint(
getbias(SMDmodel())
)
output$SMDbias <- renderUI({
g <- eggers.test(SMDmodel())
df <- data.frame(
intercept <- c(round(g$intercept,3)),
`95% CI` <- c(paste0(round(g$llci,3),' - ' ,round(g$ulci,3))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(SMDmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
SMDData(),
updateSelectInput(session,'SMDregfactor',
choices = c(getsubgroupvar(SMDData(),SMDreqcol)))
)
SMDregmodel <- reactive({
req(input$SMDregfactor)
a <- input$SMDregfactor
b <- pastreg(a,input$SMDmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = SMDmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$SMD.regmodel <- renderPrint({
req(input$SMDregfactor)
summary(SMDregmodel())
})
# Sensitivity analysis ----
output$SMDbasicO <- renderPrint({
find.outliers(SMDmodel())
})
SMDsens <- reactive({
InfluenceAnalysis(x = SMDmodel(),random = TRUE)
})
output$SMDsens_sum <- renderPrint({
SMDsens()
})
output$SMDsens_Bplot <- renderUI({
output$SMDsens_Bplot2 <- renderPlot({
x <- SMDsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('SMDsens_Bplot2')
})
output$SMDsens_ForestI2 <- renderUI({
output$SMDsens_ForestI22 <- renderPlot({
plot(SMDsens()$ForestI2)
})
plotOutput('SMDsens_ForestI22')
})
output$SMDsens_ForestEffectsize <- renderUI({
output$SMDsens_ForestEffectsize2 <- renderPlot({
plot(SMDsens()$ForestEffectSize)
})
plotOutput('SMDsens_ForestEffectsize2')
})
output$SMDsens_InfluenceCharacteristics <- renderUI({
output$SMDsens_InfluenceCharacteristics2 <- renderPlot({
plot(SMDsens()$InfluenceCharacteristics)
})
plotOutput('SMDsens_InfluenceCharacteristics2')
})
output$SMDpcurve <- renderUI({
observeEvent(c(input$SMDWc,input$SMDHc,input$SMDResc),{
output$SMDpcurve2 <- renderPlot(
width = input$SMDWc,
height =input$SMDHc,
res = input$SMDResc,
{
pcurve(SMDmodel())
}
)
}
)
plotOutput('SMDpcurve2')
})
output$downloadSMDpcurveplot <- {downloadHandler(
filename = function() {
paste('SMD Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$SMDHc*2 ,width = input$SMDWc*2, res = input$SMDResc*2)
{
pcurve(SMDmodel())
}
dev.off()
}
)}
SMDmodel.rma <- reactive({
# rma(measure = 'MN', ni= n, mi= SMD, sdi = sd, data = SMDData(),
# method = SMDmodel()$method.tau,
# test = "knha")
rma(yi = SMDmodel()$TE,
sei = SMDmodel()$seTE,
method = SMDmodel()$method.tau,
test = "knha")
})
SMDgosh <- reactive({
gosh(SMDmodel.rma())
})
output$SMDgosh_plot <- renderUI({
output$SMDgosh_plot2 <- renderPlot({
plot(SMDgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('SMDgosh_plot2')
})
SMDgoshdiagnostics <- reactive({
x <- gosh.diagnostics(SMDgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$SMDgosh_sum <- renderPrint({
SMDgoshdiagnostics()
})
output$SMDgoshdiag_plot <- renderUI({
output$SMDgoshdiag_plot2 <- renderPlot({
plot(SMDgoshdiagnostics())
})
plotOutput('SMDgoshdiag_plot2')
})
# plots ----
observeEvent(
input$SMDsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$SMDsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'SMDrghtlabl', value = y)}
)
# plots
output$SMDforestplot <- renderUI({
observeEvent(c(input$SMDW,input$SMDH,input$SMDRes),
{output$SMDforestplot2 <- renderPlot(
width = input$SMDW,
height = input$SMDH,
res = input$SMDRes,
{
SMDlftlb <- getchar(input$SMDlftlabl,',')
SMDlftcl <- getchar(input$SMDlftclm, ', ')
SMDrghtcl <- getchar(input$SMDrghtclm, ', ')
SMDrghtlb <- getchar(input$SMDrghtlabl,',')
# SMDrghtlb <- getchar(c(eval(parse(text = "SMDmodel()$sm")),getchar(input$SMDrghtlabl,',')),',')
forest(
SMDmodel(),
sortvar= unlist(SMDmodel()[input$SMDsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("SMD","95% CI"," Weight"),
rightcols = SMDrghtcl,
rightlabs = SMDrghtlb,
leftcols = SMDlftcl,
leftlabs = SMDlftlb,
pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$SMDcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$SMDcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$SMDcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$SMDtitleforest, input$SMDHtitleoffset, input$SMDVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
plotOutput('SMDforestplot2',width= paste0(input$SMDW,'px'), height = paste0(input$SMDH,'px'))
})
output$SMDfunnelplot <- renderUI({
observeEvent(c(input$SMDWp,input$SMDHp,input$SMDResp),
{output$SMDfunnelplot2 <- renderPlot(
width = input$SMDWp,
height = input$SMDHp,
res = input$SMDResp,
{funnel(
SMDmodel()$TE,SMDmodel()$seTE,
main= input$SMDfunneltitle,
# refline = SMDmodel()$TE.random,
# xlim = c(input$minSMDxlimp,input$maxSMDxlimp),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$SMDfunnelcex,
col = input$SMDfunnelstudy ,
back = input$SMDfunnelbg)
}
)}
)
plotOutput('SMDfunnelplot2',width= paste0(input$SMDWp,'px'), height = paste0(input$SMDHp,'px'))
})
output$SMDdraperyplot <- renderUI({
observeEvent(c(input$SMDWd,input$SMDHd,input$SMDResd),{
output$SMDdraperyplot2 <- renderPlot(
width = input$SMDWd,
height = input$SMDHd,
res = input$SMDResd,
{drapery(
SMDmodel(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minSMDxlimd,input$maxSMDxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$SMDDraperytitle
)
}
)}
)
plotOutput('SMDdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadSMDforestplot <- {downloadHandler(
filename = function() {
paste(input$SMDtitleforest, "png", sep = '.')},
content = function(file) {
png(file,height = input$SMDH*1.5 ,width = input$SMDW*1.5, res = input$SMDRes*1.5)
{
SMDlftlb <- getchar(input$SMDlftlabl,',')
SMDlftcl <- getchar(input$SMDlftclm, ', ')
SMDrghtcl <- getchar(input$SMDrghtclm, ', ')
SMDrghtlb <- getchar(input$SMDrghtlabl,',')
# SMDrghtlb <- getchar(c(eval(parse(text = "SMDmodel()$sm")),getchar(input$SMDrghtlabl,',')),',')
forest(
SMDmodel(),
sortvar= unlist(SMDmodel()[input$SMDsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("SMD","95% CI"," Weight"),
#leftcols = smdlftcl,
# #c("Study", "n.e","mean.e","sd.e","n.c","mean.c","sd.c"),
rightcols = SMDrghtcl,
rightlabs = SMDrghtlb,
leftcols = SMDlftcl,
leftlabs = SMDlftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$SMDcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$SMDcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$SMDcolFpred,
print.pval.Q = SMDmodel()$pval.random,
digits.sd = 2
)
grid::grid.text(input$SMDtitleforest, input$SMDHtitleoffset, input$SMDVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
dev.off()
}
)}
output$downloadSMDfunnelplot <- {downloadHandler(
filename = function() {
paste(input$SMDfunneltitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$SMDHp ,width = input$SMDWp, res = input$SMDResp)
{
funnel(SMDmodel()$TE,SMDmodel()$seTE,
main= input$SMDfunneltitle, xlim = c(input$minSMDxlimp,input$maxSMDxlimp),
level=c(90, 95, 99), shade=c("white", "red", "orange"),
cex = input$SMDfunnelcex, col = input$SMDfunnelstudy ,back = input$SMDfunnelbg)
}
dev.off()
}
)}
output$downloadSMDDraperyplot <- {downloadHandler(
filename = function() {
paste(input$SMDDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$SMDHd*2 ,width = input$SMDWd*2, res = input$SMDResd*2)
{
drapery(
SMDmodel(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minSMDxlimd,input$maxSMDxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$SMDDraperytitle
)
}
dev.off()
}
)}
# data download:
output$exSMD <- {downloadHandler(
filename = function() {
paste('SMD dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(SMDData(),file)
}
)}
# trim fill :
SMDtrimfill <- reactive({
trimfill(SMDmodel())
})
output$SMDtrimfillmodel <- renderPrint(SMDtrimfill())
observeEvent(c(input$SMDW,input$SMDH,input$SMDRes),
{output$SMDtrimfillforest <- renderPlot(
width = input$SMDW,
height = input$SMDH,
res = input$SMDRes,
{
SMDlftlb <- getchar(input$SMDlftlabl,',')
SMDlftcl <- getchar(input$SMDlftclm, ', ')
SMDrghtcl <- getchar(input$SMDrghtclm, ', ')
SMDrghtlb <- getchar(input$SMDrghtlabl,',')
forest(
SMDtrimfill(),
sortvar= unlist(SMDtrimfill()[input$SMDsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("SMD","95% CI"," Weight"),
rightcols = SMDrghtcl,
rightlabs = SMDrghtlb,
leftcols = SMDlftcl,
leftlabs = SMDlftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$SMDcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$SMDcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$SMDcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$SMDtitleforest, input$SMDHtitleoffset, input$SMDVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$SMDWp,input$SMDHp,input$SMDResp),
{output$SMDtrimfillfunnel <- renderPlot(
width = input$SMDWp,
height = input$SMDHp,
res = input$SMDResp,
{funnel(
SMDtrimfill()$TE,SMDtrimfill()$seTE,
main= input$SMDfunneltitle,
# refline = SMDmodel()$TE.random,
# xlim = c(input$minSMDxlimp,input$maxSMDxlimp),
pch = ifelse(SMDtrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$SMDfunnelcex,
col = input$SMDfunnelstudy ,
back = input$SMDfunnelbg)
}
)}
)
observeEvent(c(input$SMDWd,input$SMDHd,input$SMDResd),{
output$SMDtrimfilldrapery <- renderPlot(
width = input$SMDWd,
height = input$SMDHd,
res = input$SMDResd,
{
drapery(
SMDtrimfill(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minSMDxlimd,input$maxSMDxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$SMDDraperytitle)
}
)}
)
}
# Prop ----
{
PropData <- reactive({
if(is.null(input$file1)){
Propd <- gtdata('Prop') # Prop dataframe in global file
Propd$Study <- as.factor(Propd$Study)
Propd <- delrows(input$delr,Propd)
Propd <- delcols(input$delc,Propd)
return(Propd)
} else {return(MyDat())}
})
output$Propt <- renderTable({
chek <- function(n,h){
b <- 0
for (i in n) {
if(i %in% h){
b = b+1
} else {
b = b
}
}
return(b)
}
if(chek(Propreqcol,colnames(PropData())) == 2){
if(input$disp == "head") {
return(head( PropData()))
} else {return( PropData())
}
} else {'Error! Please revise the uploaded data for appropriate format'}
})
output$Propsummarydata <- renderPrint({
if(chek(Propreqcol,colnames(PropData())) == 2){
dataset <- PropData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
observeEvent(PropData(),
updateSelectInput(session,'Propsubgroup', selected = 'NULL',
choices = c('NULL', getsubgroupvar(PropData(),Propreqcol)))
)
# Meta object:
Propmodel <- reactive({
Prop <- PropData()
Prop$n <- as.numeric(Prop$n)
Prop$event <- as.numeric(Prop$event)
if(input$Propsubgroup == 'NULL'){
x = eval(parse(text = 'NULL'))
} else{
x <- eval(parse(text = paste0('Prop$',input$Propsubgroup)))}
Propmeta <- meta::metaprop(
event = event, n = n,
studlab = paste(Study), byvar = x,
data = Prop, sm = input$Propsm, backtransf = input$PropbackTfor,
comb.random = input$Proprandom, comb.fixed = input$Propfixed, prediction = T,
method.tau = input$Propmethodtau, hakn = TRUE
)
})
output$Prop.model <- renderPrint({
summary(Propmodel())
})
output$ProppubBias <- renderPrint(
getbias(Propmodel())
)
output$Propbias <- renderUI({
g <- eggers.test(Propmodel())
df <- data.frame(
intercept <- c(round(g$intercept,3)),
`95% CI` <- c(paste0(round(g$llci,3),' - ' ,round(g$ulci,3))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(Propmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
PropData(),
updateSelectInput(session,'Propregfactor',
choices = c(getsubgroupvar(PropData(),Propreqcol)))
)
Propregmodel <- reactive({
req(input$Propregfactor)
a <- input$Propregfactor
b <- pastreg(a,input$Propmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = Propmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$Prop.regmodel <- renderPrint({
req(input$Propregfactor)
summary(Propregmodel())
})
# Sensitivity analysis ----
output$PropbasicO <- renderPrint({
find.outliers(Propmodel())
})
Propsens <- reactive({
InfluenceAnalysis(x = Propmodel(),random = TRUE)
})
output$Propsens_sum <- renderPrint({
Propsens()
})
output$Propsens_Bplot <- renderUI({
output$Propsens_Bplot2 <- renderPlot({
x <- Propsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('Propsens_Bplot2')
})
output$Propsens_ForestI2 <- renderUI({
output$Propsens_ForestI22 <- renderPlot({
plot(Propsens()$ForestI2, cex = 2)
})
plotOutput('Propsens_ForestI22')
})
output$Propsens_ForestEffectsize <- renderUI({
output$Propsens_ForestEffectsize2 <- renderPlot({
plot(Propsens()$ForestEffectSize)
})
plotOutput('Propsens_ForestEffectsize2')
})
output$Propsens_InfluenceCharacteristics <- renderUI({
output$Propsens_InfluenceCharacteristics2 <- renderPlot({
plot(Propsens()$InfluenceCharacteristics)
})
plotOutput('Propsens_InfluenceCharacteristics2')
})
output$Proppcurve <- renderUI({
observeEvent(c(input$PropWc,input$PropHc,input$PropResc),{
output$Proppcurve2 <- renderPlot(
width = input$PropWc,
height =input$PropHc,
res = input$PropResc,
{
pcurve(Propmodel())
}
)
}
)
plotOutput('Proppcurve2')
})
output$downloadProppcurveplot <- {downloadHandler(
filename = function() {
paste('Prop Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$PropHc*2 ,width = input$PropWc*2, res = input$PropResc*2)
{
pcurve(Propmodel())
}
dev.off()
}
)}
Propmodel.rma <- reactive({
# rma(measure = 'MN', ni= n, mi= Prop, sdi = sd, data = PropData(),
# method = Propmodel()$method.tau,
# test = "knha")
rma(yi = Propmodel()$TE,
sei = Propmodel()$seTE,
method = Propmodel()$method.tau,
test = "knha")
})
Propgosh <- reactive({
gosh(Propmodel.rma())
})
output$Propgosh_plot <- renderUI({
output$Propgosh_plot2 <- renderPlot({
plot(Propgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('Propgosh_plot2')
})
Propgoshdiagnostics <- reactive({
x <- gosh.diagnostics(Propgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$Propgosh_sum <- renderPrint({
Propgoshdiagnostics()
})
output$Propgoshdiag_plot <- renderUI({
output$Propgoshdiag_plot2 <- renderPlot({
plot(Propgoshdiagnostics())
})
plotOutput('Propgoshdiag_plot2')
})
# plot ----
observeEvent(
input$Propsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$Propsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'Proprghtlabl', value = y)}
)
# plots
output$Propforestplot <- renderUI({
observeEvent(c(input$PropW,input$PropH,input$PropRes),
{output$Propforestplot2 <- renderPlot(
width = input$PropW,
height = input$PropH,
res = input$PropRes,
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
Proplftlb <- getchar(input$Proplftlabl,',')
Proplftcl <- getchar(input$Proplftclm, ', ')
Proprghtcl <- getchar(input$Proprghtclm, ', ')
Proprghtlb <- getchar(input$Proprghtlabl,',')
# Proprghtlb <- getchar(c(eval(parse(text = "Propmodel()$sm")),getchar(input$Proprghtlabl,',')),',')
forest(
Propmodel(), xlim = c(input$minPropxlim,input$maxPropxlim),
sortvar = unlist(Propmodel()[input$Propsortvar]) ,
rightcols = Proprghtcl,
rightlabs = Proprghtlb,
leftcols = Proplftcl,
leftlabs = Proplftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
ref = 0.5,
smlab = paste(input$Propsmlabforest,'\n (0.5)'), # "Proportion \n (0.5)",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$PropcolFdiamond,
# col.diamond.lines = "black",
col.square = input$PropcolFStud,
#col.square.lines = 'grey60',
col.predict = input$PropcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$Propcolgap,'cm')
)
grid::grid.text(input$Proptitleforest, input$PropHtitleoffset, input$PropVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
plotOutput('Propforestplot2',width= paste0(input$PropW,'px'), height = paste0(input$PropH,'px'))
})
output$Propfunnelplot <- renderUI({
observeEvent(c(input$PropWp,input$PropHp,input$PropResp),
{output$Propfunnelplot2 <- renderPlot(
width = input$PropWp,
height = input$PropHp,
res = input$PropResp,
{
# funnel.meta(Propmodel())
funnel(Propmodel()$TE,Propmodel()$seTE,
main= input$Propfunneltitle,
# xlim = c(Propmodel()$TE.random-0.8,
# Propmodel()$TE.random+0.8),
# xlim = c(Propmodel()$TE.random-input$minPropxlimp,
# Propmodel()$TE.random+input$maxPropxlimp),
xlim = c(input$minPropxlimp, input$maxPropxlimp),
refline = Propmodel()$TE.random,
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$Propfunnelcex,
col = input$Propfunnelstudy ,
back = input$Propfunnelbg)
}
)}
)
plotOutput('Propfunnelplot2',width= paste0(input$PropWp,'px'), height = paste0(input$PropHp,'px'))
})
output$Propdraperyplot <- renderUI({
observeEvent(c(input$PropWd,input$PropHd,input$PropResd),{
output$Propdraperyplot2 <- renderPlot(
width = input$PropWd,
height = input$PropHd,
res = input$PropResd,
{drapery(
Propmodel(), type = "pval",
labels = "studlab",
main = input$PropDraperytitle,
pos.legend = 'topright',
xlim = c(0,1.5),
layout = 'linewidth'
# legend = T,
# xlim = c(input$minPropxlimd,input$maxPropxlimd),
# lwd.max = 2,
)
# legend(x= 1, y = 0.5,
# legend=c("Random effects model","Fixed effects model", "Range of predictions"),
# col=c("red", 'blue', "lightblue"),
# pch=19, lty = 1, lwd = 2,
# # cex = 1.1,
# # inset = c(-0.5,-0.05),
# x.intersp=0.5, xjust=0, yjust=0,
# horiz=F,
# bty='n')
}
)}
)
plotOutput('Propdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadPropforestplot <- downloadHandler(
filename = function() {
paste(input$Proptitleforest, "png", sep = '.')},
content = function(file) {
png(file,height = input$PropH*1.5 ,width = (input$PropW*1.5)+100, res = input$PropRes*1.5)
{
Proplftlb <- getchar(input$Proplftlabl,',')
Proplftcl <- getchar(input$Proplftclm, ', ')
Proprghtcl <- getchar(input$Proprghtclm, ', ')
Proprghtlb <- getchar(input$Proprghtlabl,',')
# Proprghtlb <- getchar(c(eval(parse(text = "Propmodel()$sm")),getchar(input$Proprghtlabl,',')),',')
forest(
Propmodel(), xlim = c(input$minPropxlim,input$maxPropxlim),
sortvar = unlist(Propmodel()[input$Propsortvar]) ,
rightcols = Proprghtcl,
rightlabs = Proprghtlb,
leftcols = Proplftcl,
leftlabs = Proplftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
ref = 0.5,
smlab = paste(input$Propsmlabforest,'\n (0.5)'),
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$PropcolFdiamond,
# col.diamond.lines = "black",
col.square = input$PropcolFStud,
#col.square.lines = 'grey60',
col.predict = input$PropcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$Propcolgap,'cm')
)
grid::grid.text(input$Proptitleforest, input$PropHtitleoffset, input$PropVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
dev.off()
}
)
output$downloadPropfunnelplot <- downloadHandler(
filename = function() {
paste(input$Propfunneltitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$PropHp ,width = input$PropWp, res = input$PropResp)
{
# funnel.meta(Propmodel())
funnel(Propmodel()$TE,Propmodel()$seTE,
main= input$Propfunneltitle, refline = 0.5,
# xlim = c(input$minPropxlimp,input$maxPropxlimp),
level=c(90, 95, 99), shade=c("white", "red", "orange"),
cex = input$Propfunnelcex, col = input$Propfunnelstudy ,
back = input$Propfunnelbg)
}
dev.off()
}
)
output$downloadPropDraperyplot <- downloadHandler(
filename = function() {
paste(input$PropDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$PropHd*2 ,width = input$PropWd*2, res = input$PropResd*2)
{
# drapery(
# Propmodel(), type = "pval", legend = T,
# labels = "studlab",
# xlim = c(input$minPropxlimd,input$maxPropxlimd),
# layout = 'linewidth',lwd.max = 2,
# main = input$PropDraperytitle
# )
drapery(
Propmodel(), type = "pval",
labels = "studlab",
main = input$PropDraperytitle,
pos.legend = 'topright',
xlim = c(0,1.5),
layout = 'linewidth'
# legend = T,
# xlim = c(input$minPropxlimd,input$maxPropxlimd),
# lwd.max = 2,
)
}
dev.off()
}
)
# data download:
output$exProp <- downloadHandler(
filename = function() {
paste('Proportion dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(PropData(),file)
}
)
# trim fill :
Proptrimfill <- reactive({
trimfill(Propmodel())
})
output$Proptrimfillmodel <- renderPrint(Proptrimfill())
observeEvent(c(input$PropW,input$PropH,input$PropRes),
{output$Proptrimfillforest <- renderPlot(
width = input$PropW,
height = input$PropH,
res = input$PropRes,
{
Proplftlb <- getchar(input$Proplftlabl,',')
Proplftcl <- getchar(input$Proplftclm, ', ')
Proprghtcl <- getchar(input$Proprghtclm, ', ')
Proprghtlb <- getchar(input$Proprghtlabl,',')
forest(
Proptrimfill(),
sortvar= unlist(Proptrimfill()[input$Propsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("Prop","95% CI"," Weight"),
rightcols = Proprghtcl,
rightlabs = Proprghtlb,
leftcols = Proplftcl,
leftlabs = Proplftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$PropcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$PropcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$PropcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$Proptitleforest, input$PropHtitleoffset, input$PropVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$PropWp,input$PropHp,input$PropResp),
{output$Proptrimfillfunnel <- renderPlot(
width = input$PropWp,
height = input$PropHp,
res = input$PropResp,
{funnel(
Proptrimfill()$TE,Proptrimfill()$seTE,
main= input$Propfunneltitle,
# refline = Propmodel()$TE.random,
# xlim = c(input$minPropxlimp,input$maxPropxlimp),
pch = ifelse(Proptrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$Propfunnelcex,
col = input$Propfunnelstudy ,
back = input$Propfunnelbg)
}
)}
)
observeEvent(c(input$PropWd,input$PropHd,input$PropResd),
{
output$Proptrimfilldrapery <- renderPlot(
width = input$PropWd,
height = input$PropHd,
res = input$PropResd,
{
drapery(
Proptrimfill(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minPropxlimd,input$maxPropxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$PropDraperytitle)
}
)}
)
}
# COR ----
{
CORData <- reactive({
if(is.null(input$file1)){
CORd <- gtdata('COR') # COR dataframe in global file
CORd$Study <- as.factor(CORd$Study)
CORd <- delrows(input$delr,CORd)
CORd <- delcols(input$delc,CORd)
return(CORd)
} else{
return(MyDat())
}
})
output$CORt <- renderTable({
chek <- function(n,h){
b <- 0
for (i in n) {
if(i %in% h){
b = b+1
} else {
b = b
}
}
return(b)
}
if(chek(CORreqcol,colnames(CORData())) == 2){
if(input$disp == "head") {
return(head( CORData()))
} else {return( CORData())
}
} else {'Error! Please revise the uploaded data for appropriate format'}
})
output$CORsummarydata <- renderPrint({
if(chek(CORreqcol,colnames(CORData())) == 2){
dataset <- CORData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
observeEvent(CORData(),
updateSelectInput(session,'CORsubgroup', selected = 'NULL',
choices = c('NULL', getsubgroupvar(CORData(),CORreqcol)))
)
# Meta object:
CORmodel <- reactive({
COR <- CORData()
if(input$CORsubgroup == 'NULL'){
x = eval(parse(text = 'NULL'))
} else{
x <- eval(parse(text = paste0('COR$',input$CORsubgroup)))
}
CORmeta <- meta::metacor(
cor = cor, n = n,
studlab = paste(Study),
byvar = x,
data = COR, sm = input$CORsm, backtransf = input$CORbackTfor,
comb.random = input$CORrandom, comb.fixed = input$CORfixed, prediction = T,
method.tau = input$CORmethodtau, hakn = TRUE
)
})
output$COR.model <- renderPrint({
summary(CORmodel())
})
output$CORpubBias <- renderPrint(
getbias(CORmodel())
)
output$CORbias <- renderUI({
g <- eggers.test(CORmodel())
df <- data.frame(
intercept <- c(round(g$intercept,3)),
`95% CI` <- c(paste0(round(g$llci,3),' - ' ,round(g$ulci,3))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(CORmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
CORData(),
updateSelectInput(session,'CORregfactor',
choices = c(getsubgroupvar(CORData(),CORreqcol)))
)
CORregmodel <- reactive({
req(input$CORregfactor)
a <- input$CORregfactor
b <- pastreg(a,input$CORmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = CORmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$COR.regmodel <- renderPrint({
req(input$CORregfactor)
summary(CORregmodel())
})
# Sensitivity analysis ----
output$CORbasicO <- renderPrint({
find.outliers(CORmodel())
})
CORsens <- reactive({
InfluenceAnalysis(x = CORmodel(),random = TRUE)
})
output$CORsens_sum <- renderPrint({
CORsens()
})
output$CORsens_Bplot <- renderUI({
output$CORsens_Bplot2 <- renderPlot({
x <- CORsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('CORsens_Bplot2')
})
output$CORsens_ForestI2 <- renderUI({
output$CORsens_ForestI22 <- renderPlot({
plot(CORsens()$ForestI2)
})
plotOutput('CORsens_ForestI22')
})
output$CORsens_ForestEffectsize <- renderUI({
output$CORsens_ForestEffectsize2 <- renderPlot({
plot(CORsens()$ForestEffectSize)
})
plotOutput('CORsens_ForestEffectsize2')
})
output$CORsens_InfluenceCharacteristics <- renderUI({
output$CORsens_InfluenceCharacteristics2 <- renderPlot({
plot(CORsens()$InfluenceCharacteristics)
})
plotOutput('CORsens_InfluenceCharacteristics2')
})
output$CORpcurve <- renderUI({
observeEvent(c(input$CORWc,input$CORHc,input$CORResc),{
output$CORpcurve2 <- renderPlot(
width = input$CORWc,
height =input$CORHc,
res = input$CORResc,
{
pcurve(CORmodel())
}
)
}
)
plotOutput('CORpcurve2')
})
output$downloadCORpcurveplot <- {downloadHandler(
filename = function() {
paste('COR Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$CORHc*2 ,width = input$CORWc*2, res = input$CORResc*2)
{
pcurve(CORmodel())
}
dev.off()
}
)}
CORmodel.rma <- reactive({
# rma(measure = 'MN', ni= n, mi= COR, sdi = sd, data = CORData(),
# method = CORmodel()$method.tau,
# test = "knha")
rma(yi = CORmodel()$TE,
sei = CORmodel()$seTE,
method = CORmodel()$method.tau,
test = "knha")
})
CORgosh <- reactive({
gosh(CORmodel.rma())
})
output$CORgosh_plot <- renderUI({
output$CORgosh_plot2 <- renderPlot({
plot(CORgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('CORgosh_plot2')
})
CORgoshdiagnostics <- reactive({
x <- gosh.diagnostics(CORgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$CORgosh_sum <- renderPrint({
CORgoshdiagnostics()
})
output$CORgoshdiag_plot <- renderUI({
output$CORgoshdiag_plot2 <- renderPlot({
plot(CORgoshdiagnostics())
})
plotOutput('CORgoshdiag_plot2')
})
# plots ----
observeEvent(
input$CORsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$CORsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'CORrghtlabl', value = y)}
)
# plots
output$CORforestplot <- renderUI({
observeEvent(c(input$CORW,input$CORH,input$CORRes),
output$CORforestplot2 <- renderPlot(
width = input$CORW,
height = input$CORH,
res = input$CORRes,
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
CORlftlb <- getchar(input$CORlftlabl,',')
CORlftcl <- getchar(input$CORlftclm, ', ')
CORrghtcl <- getchar(input$CORrghtclm, ', ')
CORrghtlb <- getchar(input$CORrghtlabl,',')
# CORrghtlb <- getchar(c(eval(parse(text = "CORmodel()$sm")),getchar(input$CORrghtlabl,',')),',')
forest(
CORmodel(), xlim = c(input$minCORxlim,input$maxCORxlim),
sortvar= unlist(CORmodel()[input$CORsortvar]),
rightcols = CORrghtcl,
rightlabs = CORrghtlb,
leftcols = CORlftcl,
leftlabs = CORlftlb,
# leftcols= c('studlab','cor','n'),
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$CORcolFdiamond,
# col.diamond.lines = "black",
col.square = input$CORcolFStud,
#col.square.lines = 'grey60',
col.predict = input$CORcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$CORcolgap,'cm')
)
grid::grid.text(input$CORtitleforest, input$CORHtitleoffset, input$CORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)
)
plotOutput('CORforestplot2',width= paste0(input$CORW,'px'), height = paste0(input$CORH,'px'))
})
output$CORfunnelplot <- renderUI({
observeEvent(c(input$CORWp,input$CORHp,input$CORResp),
output$CORfunnelplot2 <- renderPlot(
width = input$CORWp,
height = input$CORHp,
res = input$CORResp,
funnel(
CORmodel()$TE, CORmodel()$seTE, level=c(90, 95, 99),
main= input$CORfunneltitle, xlim = c(input$minCORxlimp,input$maxCORxlimp),
shade=c("white", "red", "orange"),
cex = input$CORfunnelcex, col = input$CORfunnelstudy ,back = input$CORfunnelbg)
)
)
plotOutput('CORfunnelplot2',width= paste0(input$CORWp,'px'), height = paste0(input$CORHp,'px'))
})
output$CORdraperyplot <- renderUI({
observeEvent(c(input$CORWd,input$CORHd,input$CORResd),{
output$CORdraperyplot2 <- renderPlot(
width = input$CORWd,
height = input$CORHd,
res = input$CORResd,
{drapery(
CORmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minCORxlimd,input$maxCORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$CORDraperytitle
)
}
)}
)
plotOutput('CORdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadCORforestplot <- downloadHandler(
filename = function() {
paste(input$CORtitleforest, "png", sep = '.')},
content = function(file) {
png(file,height = input$CORH*1.5 ,width = input$CORW*1.5, res = input$CORRes*1.5)
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
CORlftlb <- getchar(input$CORlftlabl,',')
CORlftcl <- getchar(input$CORlftclm, ', ')
CORrghtcl <- getchar(input$CORrghtclm, ', ')
CORrghtlb <- getchar(input$CORrghtlabl,',')
# CORrghtlb <- getchar(c(eval(parse(text = "CORmodel()$sm")),getchar(input$CORrghtlabl,',')),',')
forest(
CORmodel(), xlim = c(input$minCORxlim,input$maxCORxlim),
sortvar= unlist(CORmodel()[input$CORsortvar]),
rightcols = CORrghtcl,
rightlabs = CORrghtlb,
leftcols = CORlftcl,
leftlabs = CORlftlb,
# leftcols= c('studlab','cor','n'),
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$CORcolFdiamond,
# col.diamond.lines = "black",
col.square = input$CORcolFStud,
#col.square.lines = 'grey60',
col.predict = input$CORcolFpred,
print.pval.Q = T,
digits.sd = 2,
colgap.forest.left = paste0(input$CORcolgap,'cm')
)
grid::grid.text(input$CORtitleforest, input$CORHtitleoffset, input$CORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
dev.off()
}
)
output$downloadCORfunnelplot <- downloadHandler(
filename = function() {
paste(input$CORfunneltitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$CORHp ,width = input$CORWp, res = input$CORResp)
{
funnel(CORmodel()$TE,CORmodel()$seTE,
main= input$CORfunneltitle, xlim = c(input$minCORxlimp,input$maxCORxlimp),
level=c(90, 95, 99), shade=c("white", "red", "orange"),
cex = input$CORfunnelcex, col = input$CORfunnelstudy ,back = input$CORfunnelbg)
}
dev.off()
}
)
output$downloadCORDraperyplot <- downloadHandler(
filename = function() {
paste(input$CORDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$CORHd*2 ,width = input$CORWd*2, res = input$CORResd*2)
{
drapery(
CORmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minCORxlimd,input$maxCORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$CORDraperytitle
)
}
dev.off()
}
)
# data download:
output$exCOR <- downloadHandler(
filename = function() {
paste('Correlation dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(CORData(),file)
}
)
# trim fill :
CORtrimfill <- reactive({
trimfill(CORmodel())
})
output$CORtrimfillmodel <- renderPrint(CORtrimfill())
observeEvent(c(input$CORW,input$CORH,input$CORRes),
{output$CORtrimfillforest <- renderPlot(
width = input$CORW,
height = input$CORH,
res = input$CORRes,
{
CORlftlb <- getchar(input$CORlftlabl,',')
CORlftcl <- getchar(input$CORlftclm, ', ')
CORrghtcl <- getchar(input$CORrghtclm, ', ')
CORrghtlb <- getchar(input$CORrghtlabl,',')
forest(
CORtrimfill(),
sortvar= unlist(CORtrimfill()[input$CORsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("COR","95% CI"," Weight"),
rightcols = CORrghtcl,
rightlabs = CORrghtlb,
leftcols = CORlftcl,
leftlabs = CORlftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$CORcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$CORcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$CORcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$CORtitleforest, input$CORHtitleoffset, input$CORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$CORWp,input$CORHp,input$CORResp),
{output$CORtrimfillfunnel <- renderPlot(
width = input$CORWp,
height = input$CORHp,
res = input$CORResp,
{funnel(
CORtrimfill()$TE,CORtrimfill()$seTE,
main= input$CORfunneltitle,
# refline = CORmodel()$TE.random,
# xlim = c(input$minCORxlimp,input$maxCORxlimp),
pch = ifelse(CORtrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$CORfunnelcex,
col = input$CORfunnelstudy ,
back = input$CORfunnelbg)
}
)}
)
observeEvent(c(input$CORWd,input$CORHd,input$CORResd),{
output$CORtrimfilldrapery <- renderPlot(
width = input$CORWd,
height = input$CORHd,
res = input$CORResd,
{
drapery(
CORtrimfill(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minCORxlimd,input$maxCORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$CORDraperytitle)
}
)}
)
}
# OR ----
{
{
# metaobject <- reactive({
# OR <- ORData()
# OR$mean.e <- as.numeric(OR$mean.e)
# OR$n.e <- as.numeric(OR$n.e)
# OR$sd.e <- as.numeric(OR$sd.e)
# OR$mean.c <- as.numeric(OR$mean.c)
# OR$n.c <- as.numeric(OR$n.c)
# OR$sd.c <- as.numeric(OR$sd.c)
# model <- meta::metacont(
# mean.e = mean.e,
# sd.e = sd.e,
# n.e= n.e,
# mean.c= mean.c,
# sd.c = sd.c,
# n.c = n.c,
# data = OR,
# sm = 'OR',
# comb.random = T, comb.fixed = F,
# prediction = T,
# studlab = paste(Study),
# method.tau = input$methodtau, method.smd = input$methodsmd,
# label.e = 'Sicklers', label.c = 'Non-Sicklers',
# )
# return(model)
# })
}
ORData <- reactive({
if(is.null(input$file1)){
OR <- gtdata('OR')
OR$Study <- as.factor(OR$Study)
OR <- delrows(input$delr,OR)
OR <- delcols(input$delc,OR)
return(OR)
} else {return(MyDat())}
})
output$ORt <- renderTable({
chek <- function(n,h){
b <- 0
for (i in n) {
if(i %in% h){
b = b+1
} else {
b = b
}
}
return(b)
}
if(chek(ORreqcol,colnames(ORData())) == 4){
if(input$disp == "head") {
return(head( ORData()))
} else {return( ORData())
}
} else {'Error! Please revise the uploaded data for appropriate format'}
})
output$ORsummarydata <- renderPrint({
if(chek(ORreqcol,colnames(ORData())) == 4){
dataset <- ORData()
summary(dataset)
} else {'Error! Please revise the uploaded data for appropriate format'}
})
# subgroup analysis
observeEvent(ORData(),
updateSelectInput(session,'ORsubgroup', selected = 'NULL',
choices = c('NULL', getsubgroupvar(ORData(),ORreqcol)))
)
# Meta object:
ORmodel <- reactive({
OR <- ORData()
if(input$ORsubgroup == 'NULL'){
x = eval(parse(text = 'NULL'))
} else{
x <- eval(parse(text = paste0('OR$',input$ORsubgroup)))
}
ORmeta <- meta::metabin(
event.e = event.e, n.e = n.e,
event.c = event.c, n.c = n.c,
studlab = paste(Study),
byvar = x,
data = OR, sm = 'OR',
comb.random = input$ORrandom, comb.fixed = input$ORfixed, prediction = T,
method.tau = input$ORmethodtau, hakn = TRUE, incr = 0.1
)
})
output$OR.model <- renderPrint({
summary(ORmodel())
})
output$ORpubBias <- renderPrint({
# meta::metabias.meta(ORmodel(), k.min = 4)
getbias(ORmodel())
})
output$ORbias <- renderUI({
g <- eggers.test(ORmodel())
df <- data.frame(
intercept <- c(round(g$intercept,3)),
`95% CI` <- c(paste0(round(g$llci,3),' - ' ,round(g$ulci,3))),
t <- c(round(g$t,3)),
p <- c(round(g$p,3))
)
colnames(df) <- c('intercept','95% CI','t','p')
df[2,] <- df[1,]
df[1,] <- colnames(df)
HTML(
{x <- df %>%
kbl(align = "c",format="html") %>%
# kable_paper("hover", full_width = T) %>%
kable_styling(
full_width = T,
font_size = 15,
bootstrap_options = c("striped", "hover","condensed", "responsive"),
position = "float_right"
) %>%
column_spec(3,popover = paste("am:", df$t[1:3])) %>%
# row_spec(c(0,2),bold = T) %>%
row_spec(c(0,1), bold = T,border_below <- F)%>%
# pack_rows("Group 1",#background = '#E2F5EE',
# index = paste('Egger\'s test Bias results: ')) %>%
pack_rows("Group 1",#background = '#E2F5EE',
index = paste0('Egger\'s test: ',getbias(ORmodel())$result))
gsub("<thead>.*</thead>", "", x)}
)
})
# Advanced analysis ----
# Meta-regression:
observeEvent(
ORData(),
updateSelectInput(session,'ORregfactor',
choices = c(getsubgroupvar(ORData(),ORreqcol)))
)
ORregmodel <- reactive({
req(input$ORregfactor)
a <- input$ORregfactor
b <- pastreg(a,input$ORmodtype)
# v <- as.formula(~ eval(parse(text = b)))
v <- c('~',b)
v <- as.formula(paste(v,collapse = " "))
g <- metareg(x = ORmodel(), formula = v)
# dimnames(g$beta)[[1]] <- list('intercept', b)
g
})
output$OR.regmodel <- renderPrint({
req(input$ORregfactor)
summary(ORregmodel())
})
# Sensitivity analysis ----
output$ORbasicO <- renderPrint({
find.outliers(ORmodel())
})
ORsens <- reactive({
InfluenceAnalysis(x = ORmodel(),random = TRUE)
})
output$ORsens_sum <- renderPrint({
ORsens()
})
output$ORsens_Bplot <- renderUI({
output$ORsens_Bplot2 <- renderPlot({
x <- ORsens()
plot(x$BaujatPlot)
# plot(x, "baujat")
})
plotOutput('ORsens_Bplot2')
})
output$ORsens_ForestI2 <- renderUI({
output$ORsens_ForestI22 <- renderPlot({
plot(ORsens()$ForestI2)
})
plotOutput('ORsens_ForestI22')
})
output$ORsens_ForestEffectsize <- renderUI({
output$ORsens_ForestEffectsize2 <- renderPlot({
plot(ORsens()$ForestEffectSize)
})
plotOutput('ORsens_ForestEffectsize2')
})
output$ORsens_InfluenceCharacteristics <- renderUI({
output$ORsens_InfluenceCharacteristics2 <- renderPlot({
plot(ORsens()$InfluenceCharacteristics)
})
plotOutput('ORsens_InfluenceCharacteristics2')
})
output$ORpcurve <- renderUI({
observeEvent(c(input$ORWc,input$ORHc,input$ORResc),{
output$ORpcurve2 <- renderPlot(
width = input$ORWc,
height =input$ORHc,
res = input$ORResc,
{
pcurve(ORmodel())
}
)
}
)
plotOutput('ORpcurve2')
})
output$downloadORpcurveplot <- {downloadHandler(
filename = function() {
paste('OR Pcurve plot', "png", sep = '.')
},
content = function(file) {
png(file,height = input$ORHc*2 ,width = input$ORWc*2, res = input$ORResc*2)
{
pcurve(ORmodel())
}
dev.off()
}
)}
ORmodel.rma <- reactive({
rma(yi = ORmodel()$TE,
sei = ORmodel()$seTE,
method = ORmodel()$method.tau,
test = "knha")
})
ORgosh <- reactive({
gosh(ORmodel.rma())
})
output$ORgosh_plot <- renderUI({
output$ORgosh_plot2 <- renderPlot({
plot(ORgosh(),alpha = 0.01, col = 'blue')
})
plotOutput('ORgosh_plot2')
})
ORgoshdiagnostics <- reactive({
x <- gosh.diagnostics(ORgosh(), km.params = list(centers = 2),
db.params = list(eps = 0.08, MinPts = 50))
x
})
output$ORgosh_sum <- renderPrint({
ORgoshdiagnostics()
})
output$ORgoshdiag_plot <- renderUI({
output$ORgoshdiag_plot2 <- renderPlot({
plot(ORgoshdiagnostics())
})
plotOutput('ORgoshdiag_plot2')
})
# plots ----
observeEvent(
input$ORsm,
{
Ori <- c(" 95% CI, Weight")
u <- input$ORsm
x <- getchar(Ori,',')
y <- paste(c(u , getchar(x,',')))
updateTextInput(session,'ORrghtlabl', value = y)}
)
# plots
output$ORforestplot <- renderUI({
observeEvent(c(input$ORW,input$ORH,input$ORRes),
{output$ORforestplot2 <- renderPlot(
width = input$ORW,
height = input$ORH,
res = input$ORRes,
{{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
ORlftlb <- getchar(input$ORlftlabl,',')
ORlftcl <- getchar(input$ORlftclm, ', ')
ORrghtcl <- getchar(input$ORrghtclm, ', ')
# ORrghtlb <- getchar(input$ORrghtlabl,',')
ORrghtlb <- getchar(c(eval(parse(text = "ORmodel()$sm")),getchar(input$ORrghtlabl,',')),',')
forest(
ORmodel(), ref = 1,
sortvar= unlist(ORmodel()[input$ORsortvar]),
rightcols = ORrghtcl,
rightlabs = ORrghtlb,
leftcols = ORlftcl,
leftlabs = ORlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$ORcolFdiamond,
# col.diamond.lines = "black",
col.square = input$ORcolFStud,
#col.square.lines = 'grey60',
col.predict = input$ORcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$ORtitleforest, input$ORHtitleoffset, input$ORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}}
)}
)
plotOutput('ORforestplot2',width= paste0(input$ORW,'px'), height = paste0(input$ORH,'px'))
})
output$ORfunnelplot <- renderUI({
observeEvent(c(input$ORWp,input$ORHp,input$ORResp),
{output$ORfunnelplot2 <- renderPlot(
width = input$ORWp,
height = input$ORHp,
res = input$ORResp,
{funnel(
ORmodel()$TE, ORmodel()$seTE, level=c(90, 95, 99),
main= input$ORtitlefunnel, xlim = c(input$minORxlimp,input$maxORxlimp),
shade=c("white", "red", "orange"),
cex = input$ORfunnelcex, col = input$ORfunnelstudy ,back = input$ORfunnelbg)}
)}
)
plotOutput('ORfunnelplot2',width= paste0(input$ORWp,'px'), height = paste0(input$ORHp,'px'))
})
output$ORdraperyplot <- renderUI({
observeEvent(c(input$ORWd,input$ORHd,input$ORResd),{
output$ORdraperyplot2 <- renderPlot(
width = input$ORWd,
height = input$ORHd,
res = input$ORResd,
{drapery(
ORmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minORxlimd,input$maxORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$ORDraperytitle
)
}
)}
)
plotOutput('ORdraperyplot2')
})
# Downloadable plot of selected dataset ----
output$downloadORforestplot <- downloadHandler(
filename = function() {
paste(input$ORtitleforest, "png", sep = '.')},
content = function(file) {
png(file,height = input$ORH*1.5 ,width = input$ORW*1.5, res = input$ORRes*1.5)
{
{
# dataget <- function(g){
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# dataget2 <- function(g){
# if(is.null(input$file1)){
# OR <- metafor::dat.normand1999;
# colnames(OR) <- c("Study","source",'n.e' ,'mean.e', 'sd.e', 'n.c' ,'mean.c', 'sd.c');OR$Study <- as.factor(OR$Study)
# return(OR)
# } else{
# g <- input$file1$datapath
# OR <- if(tools::file_ext(g) == 'csv'){
# OR <- read.csv(input$file1$datapath, header = input$header,
# sep = input$sep, quote = input$quote)}
# else{
# OR <- readxl::read_excel(input$file1$datapath, sheet = input$sheet,
# n_max = input$nmax,
# col_names = input$Colname,
# skip = input$Skip)
# }
# return(OR)
# }
# }
#OR <- dataget(input$file1$datapath)
#OR <- dataget2(input$file1$datapath)
}
ORlftlb <- getchar(input$ORlftlabl,',')
ORlftcl <- getchar(input$ORlftclm, ', ')
ORrghtcl <- getchar(input$ORrghtclm, ', ')
# ORrghtlb <- getchar(input$ORrghtlabl,',')
ORrghtlb <- getchar(c(eval(parse(text = "ORmodel()$sm")),getchar(input$ORrghtlabl,',')),',')
forest(
ORmodel(),
sortvar= unlist(ORmodel()[input$ORsortvar]),
rightcols = ORrghtcl,
rightlabs = ORrghtlb,
leftcols = ORlftcl,
leftlabs = ORlftlb,
# lab.e = input$ORintervention,
# lab.c = input$ORcontrol,
pooled.totals = T,
# smlab = "Standardized mean\n difference",
# text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$ORcolFdiamond,
# col.diamond.lines = "black",
col.square = input$ORcolFStud,
#col.square.lines = 'grey60',
col.predict = input$ORcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$ORtitleforest, input$ORHtitleoffset, input$ORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
dev.off()
}
)
output$downloadORfunnelplot <- downloadHandler(
filename = function() {
paste(input$ORtitlefunnel, "png", sep = '.')
},
content = function(file) {
png(file,height = input$ORHp ,width = input$ORWp, res = input$ORResp)
funnel(
ORmodel()$TE, ORmodel()$seTE, level=c(90, 95, 99),
main= input$ORfunneltitle, xlim = c(input$minORxlimp,input$maxORxlimp),
shade=c("white", "red", "orange"),
cex = input$ORfunnelcex, col = input$ORfunnelstudy ,back = input$ORfunnelbg)
dev.off()
}
)
output$downloadORDraperyplot <- downloadHandler(
filename = function() {
paste(input$ORDraperytitle, "png", sep = '.')
},
content = function(file) {
png(file,height = input$ORHd*2 ,width = input$ORWd*2, res = input$ORResd*2)
{
drapery(
ORmodel(), type = "pval", legend = T,
labels = "studlab",
xlim = c(input$minORxlimd,input$maxORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$ORDraperytitle
)
}
dev.off()
}
)
# data download:
output$exOR <- downloadHandler(
filename = function() {
paste('OR dataset', "csv", sep = '.')
},
content = function(file) {
write.csv(ORData(),file)
}
)
# trim fill :
ORtrimfill <- reactive({
trimfill(ORmodel())
})
output$ORtrimfillmodel <- renderPrint(ORtrimfill())
observeEvent(c(input$ORW,input$ORH,input$ORRes),
{output$ORtrimfillforest <- renderPlot(
width = input$ORW,
height = input$ORH,
res = input$ORRes,
{
ORlftlb <- getchar(input$ORlftlabl,',')
ORlftcl <- getchar(input$ORlftclm, ', ')
ORrghtcl <- getchar(input$ORrghtclm, ', ')
ORrghtlb <- getchar(input$ORrghtlabl,',')
forest(
ORtrimfill(),
sortvar= unlist(ORtrimfill()[input$ORsortvar]),
# rightcols = c("effect","ci", "w.random"),
# #rightlabs = c("OR","95% CI"," Weight"),
rightcols = ORrghtcl,
rightlabs = ORrghtlb,
leftcols = ORlftcl,
leftlabs = ORlftlb,
# #c("Study", "N","Mean","SD","N","Mean","SD"),
# pooled.totals = T,
# # smlab = "Standardized mean\n difference",
#text.random = "Overall effect(Random)",
print.I2.ci = TRUE,
print.tau2 = T,
col.diamond = input$ORcolFdiamond,
# #col.diamond.lines = "black",
col.square = input$ORcolFStud,
# #col.square.lines = 'grey60',
col.predict = input$ORcolFpred,
print.pval.Q = T,
digits.sd = 2
)
grid::grid.text(input$ORtitleforest, input$ORHtitleoffset, input$ORVtitleoffset, gp=grid::gpar(cex=1.2,fontface=2))
}
)}
)
observeEvent(c(input$ORWp,input$ORHp,input$ORResp),
{output$ORtrimfillfunnel <- renderPlot(
width = input$ORWp,
height = input$ORHp,
res = input$ORResp,
{funnel(
ORtrimfill()$TE,ORtrimfill()$seTE,
main= input$ORfunneltitle,
# refline = ORmodel()$TE.random,
# xlim = c(input$minORxlimp,input$maxORxlimp),
pch = ifelse(ORtrimfill()$trimfill, 1, 16),
level=c(90, 95, 99),
shade=c("white", "red", "orange"),
cex = input$ORfunnelcex,
col = input$ORfunnelstudy ,
back = input$ORfunnelbg)
}
)}
)
observeEvent(c(input$ORWd,input$ORHd,input$ORResd),{
output$ORtrimfilldrapery <- renderPlot(
width = input$ORWd,
height = input$ORHd,
res = input$ORResd,
{
drapery(
ORtrimfill(), type = "pval", legend = T,
labels = "studlab", lwd.random = 3,
xlim = c(input$minORxlimd,input$maxORxlimd),
layout = 'linewidth',lwd.max = 2,
main = input$ORDraperytitle)
}
)}
)
}
observeEvent(input$logout,{
logout()
})
}
# )
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.