Nothing
R/fut_GUI_MRMC_shiny.R
In BayesianFROC: FROC Analysis by Bayesian Approaches
Defines functions
fit_GUI_Shiny_MRMC
Documented in
fit_GUI_Shiny_MRMC
#' @title Fit with GUI via Shiny (in case of MRMC)
#' @description
#' Fit a Bayesian model with GUI.
#'
#' Revised 2019 Nov.
#'
#'
#' @details
#' In what follows, we assume that our dataset has more than two readers or modalities,
#' namely, our dataset is MRMC case.
#' The term \emph{imaging modality},
#' we mean a set of imaging methods such as MRI, CT, PET, etc.
#'
#'
#' Revised 2019 Nov 25.
#' Revised 2020 Jan
#' @param DF A dataframe, cosisting of five vectors: reader ID, modality ID, confidence levels, hits, false alarms.
#'
#' initial data to be fited
# @param outdir I use \code{ system.file("myapp", package = "BayesianFROC") }
# @param outfilename I do not know :'-D
#' @param NL.max max number of bins indicating the maximal number in which the number of lesions can move
#' @param NI.max max number of bins indicating the maximal number in which the number of imagegs can move
#' @param NL.initial Natural number indicating the initial number of lesions, Default value =142.
#' @param NI.initial Natural number indicating the initial number of images, Default value =199.
#' @param MCMC.chains.max max number of bins indicating number of MCMC chains
#' @param seed.initial.of.MCMC positive integers indicating the initial seed of MCMC sampling. Default is 1234.
#' @param DF_MQC A data frame, consisting of three numbers, i.e., the number of modalities, readers, confidence levels. Of course, these numbers should be compatible with the variable \code{DF}.
#' @return None
#' @export
#@examples-------
#' @examples
#'
#' \dontrun{
#'
#'#'## Only run examples in interactive R sessions
#'if (interactive()) {
#'#========================================================================================
#'# 1) Use the default User Interface
#'#========================================================================================
#'#'
#'
#' #No need to consider the variables, it is sufficient in default values.
#'
#'
#' fit_GUI_Shiny()
#'
#'
#'
#'
#'#========================================================================================
#'# 2) From exsisting dataset, named dddddd or ddddd or ddd
#'#========================================================================================
#'
#'
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(dddddd))
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(ddddd))
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(ddd))
#'
#'
#'
#'
#'#========================================================================================
#'# 2) data of 11 readers and a single modality
#'#========================================================================================
#'
#'
#'
#' d <- dataset_creator_for_many_Readers(1,11)
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(d))
#'
#'
#'
#'
#'
#'
#'
#'
#'
#'
#'#========================================================================================
#'# see = 2345678 convergence 37readers, 1 modality
#'#========================================================================================
#'
#'
#'
#' v <- v_truth_creator_for_many_readers_MRMC_data(M=1,Q=37)
#' m <- mu_truth_creator_for_many_readers_MRMC_data(M=1,Q=37)
#' d <- create_dataList_MRMC(mu.truth = m,v.truth = v)
#'
#'
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(d),
#' seed.initial.of.MCMC = 2345678,
#' NL.initial = d$NL,
#' NI.initial = d$NI)
#'
#'
#'
#'
#'
#'
#'
#'
#'#========================================================================================
#'# 2) From exsisting dataset, named dddd
#'#========================================================================================
#'
#'
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(dddd))
#'
#'
#' # This dataset named dddd is a dataset consisting of
#' # only a single reader and mutiple modality.
#' # Such a single reader and mutiple modality case had error caused
#' # by some reduction of array to vector.
#' # So, the program was fixed so that such special case is also available
#' # 2020 Feb 24
#'
#' # To reflect the information of the number of lesions and images,
#' # use the following.
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(dddd),
#' NL.initial = dddd$NL,
#' NI.initial = dddd$NI)
#'
#'
# ####1#### ####2#### ####3#### ####4#### ####5#### ####6#### ####7#### ####8#### ####9####
#'#========================================================================================
#'# example
#'#========================================================================================
#'
#'
#'
#'
#' v <- v_truth_creator_for_many_readers_MRMC_data(M=2,Q=7)
#' m <- mu_truth_creator_for_many_readers_MRMC_data(M=2,Q=7)
#' d <- create_dataList_MRMC(mu.truth = m,v.truth = v)
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(d))
#'
#'
#'
# ####1#### ####2#### ####3#### ####4#### ####5#### ####6#### ####7#### ####8#### ####9####
#'#========================================================================================
#'# non-convergent example
#'#========================================================================================
#'
#'
#' v <- v_truth_creator_for_many_readers_MRMC_data(M=3,Q=7)
#' m <- mu_truth_creator_for_many_readers_MRMC_data(M=3,Q=7)
#' d <- create_dataList_MRMC(mu.truth = m,v.truth = v)
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(d),seed.initial.of.MCMC = 23)
#'
#'
#'
#'
#'}### Only run examples in interactive R sessions
#'
#'
#'}
#'
fit_GUI_Shiny_MRMC <- function(
# Initial data -----
DF=data.frame(
m=as.integer(BayesianFROC::dd$m),
q=as.integer(BayesianFROC::dd$q),
c=as.integer(BayesianFROC::dd$c),
h=as.integer(BayesianFROC::dd$h),
f=as.integer(BayesianFROC::dd$f)
),
DF_MQC = data.frame(M=max(DF$m),
Q=max(DF$q),
C=max(DF$c)
),
# DF = dd,
NL.max=1111,
NI.max=1111,
#NL.initial ----
NL.initial = 142,
NI.initial = 199,
seed.initial.of.MCMC=237410,
# MCMC.samples.max = 11111,
MCMC.chains.max=4
# counter=0
){
outdir <- system.file("myapp", package = "BayesianFROC")
outfilename <- "table"
if (outdir == "") {
stop("Could not find myapp. Try re-installing `BayesianFROC`.", call. = FALSE)
}
# shiny::shinyUI(
# shiny::fluidPage(
ui <- shiny::navbarPage("Emplooooo\\(^o^)/oooooooy me! :'-D",
shiny::tabPanel(":) :-'D",
# shiny::tags$head(
# shiny::tags$link(rel = "stylesheet", type = "text/css", href = "styles.css")
# # , shiny::tags$script(src= "color_change.js")
# ) ,# Color
# CSS -----
shiny::tags$head(
shinythemes::themeSelector(),
shiny::tags$style(shiny::HTML("
/*Dragabble panel style heeeeeehaaaaaa*/
.ui-draggable {
z-index: 11;
background-color:#B0A9A9;
font-size: 14pt;
border-top: 1px solid #991313; border-bottom: 5px solid 991313; border-radius: 23px; border: 3px solid white;
}
/*Slider_input From here heeehaaaa*/
.irs-single {font-family: 'arial'; color:#B30E0E; background:#E0D162; font-size:17pt; }
.irs-slider {width: 65px; height: 60px; top: 35px; background:#870C0C; border-radius: 100px;}
.irs-max {font-family: 'arial'; color: black; background:#9E9898; font-size: 14pt}
.irs-min {font-family: 'arial'; color: black; background:#9E9898; font-size: 14pt}
.irs-bar { width: 100%; height: 15px; background: #991313; border-top: 1px solid #2e6da4; border-bottom: 1px solid black; border-radius: 33px; border: 1px solid #2e6da4; }
.irs-bar-edge { width: 40px; height: 15px; background: #991313; border-top: 1px solid #2e6da4; border-bottom: 1px solid black; border-radius: 33px; border: 1px solid #2e6da4; }
.irs-line { height: 15px; border-radius: 33px;border: 1px solid black; }
.irs-grid-pol {display: none;}
/*Slider_input From here heeehaaaa*/
.checkbox { /* checkbox is a div class*/
line-height: 30px;
margin-bottom: 40px; /*set the margin, so boxes don't overlap*/
font-size:17pt;
background:#C2C2C2;
color:black;/* font color*/
border-radius: 100px;
}
input[type='checkbox']{ /* style for checkboxes */
width: 32px; /*Desired width*/
height: 32px; /*Desired height*/
line-height: 32px;
}
span {
margin-left: 15px; /*set the margin, so boxes don't overlap labels*/
line-height: 20px;
}
"))
),#taghead #cols <- colourpicker::colourPicker(5) "#CC5858" #FF8800 "#B0A9A9" "#B8940263" "#70BBC7" "#C29999" #F07878 #E8906D9B #CCCCFF #9DCDD1 #F26666 background-color: #CCCCCF;
shiny::titlePanel(" FROC Analysis by Issei Tsunoda "),
shiny::h4(shiny::helpText("Change Data, then estimates and plotted curves are fitted accordingly. Enjoy fitting the FROC model to various datasets! Cheers! Pretty crowd!")),
# shiny::fluidRow(
# column(6, # shiny::h2(" FROC Data"),
#checkbox vectors of modalty ID, reader ID-------
shiny::absolutePanel( draggable = TRUE, style ="red",fixed=TRUE,
shiny::h1("Specify IDs"),
shiny::h6(shiny::helpText("Specified IDs will be plotted")),
shiny::uiOutput("checkbox_GUI_Readers"),
shiny::textOutput("txt_user_specifies_reader_IDs"),
shiny::uiOutput("checkbox_GUI_Modality"),
shiny::textOutput("txt_user_specifies_Modality_IDs"),
),
# Data -----
shiny::absolutePanel( draggable = TRUE, style ="red",fixed=TRUE,
# top = "100%",
# left = 1,
# right = 1,
# bottom = 1,
# width = 1,
# height = 1,
shiny::h1("Data"),
# shiny::numericInput("Number_of_modalities",
# "Number of modalities:",
# value = max(DF$m)# Default ----------
# ),
# shiny::numericInput("Number_of_readers",
# "Number of readers:",
# value = max(DF$q)# Default ----------
# ),
# shiny::numericInput("Number_of_confidence_levels",
# "Number of confidence levels:",
# value = max(DF$c)# Default ----------
# ),
# # shiny::actionButton("trigger_skeleton_of_data","Make a skeleton of data"),
#
shiny::sliderInput("Number_of_lesions",
"Number of lesions:",
min = 1, max = NL.max,
value = NL.initial# Default
),
shiny::sliderInput("Number_of_images",
"Number of images:",
min = 1, max = NI.max,
value = NI.initial#Default
),
shiny::h4(shiny::helpText( "Right-click on the table to delete/insert rows." )),
shiny::h4(shiny::helpText( "Double-click on a cell to edit")),
# shiny::h6(shiny::helpText(" h = hit = True Positive = TP.")),
# shiny::h6(shiny::helpText(" f = false alarms = False Positive = FP.")),
#
# shiny::h6(shiny::helpText(" m = modality ID")),
# shiny::h6(shiny::helpText(" q = reader ID")),
# shiny::h6(shiny::helpText(" c = confidence level")),
# TABLE data Handsontable-----
# rhandsontable::rHandsontableOutput("data_frame"),# Table of h and f
shiny::h4( shiny::strong( shiny::span( rhandsontable::rHandsontableOutput("data_frame") , style="color:#B30E0E; font-size:17pt;") ) ),# Table of h and f
shiny::h4(shiny::helpText( "To make a skeleton of dataset, use the followings " )),
# shiny::h4(shiny::helpText( "the author provides the following, " )),
# shiny::h4(shiny::helpText( "Tby which we can obtain a skeleton of dataset." )),
# TABLE of MQC -----
shiny::h4( shiny::strong( shiny::span( rhandsontable::rHandsontableOutput("data_frame_MQC") , style="color:#B30E0E; font-size:17pt;") ) ),# Table of h and f
shiny::h6(shiny::helpText("To edit more than 2 cells, a blank cell would help"))
# shiny::br()
), #absolutePanel
#MCMC param ------
shiny::absolutePanel( draggable = TRUE, style ="red",fixed=TRUE,
# top = "100%",
# left = 1,
# right = 1,
# bottom = 1,
# width = 1,
# height = 1,
shiny::h4("Parameter of the HMC"),
shiny::h4(shiny::helpText(" Larger is better.")),
#Number_of_MCMC_samples-----
shiny::sliderInput("Number_of_MCMC_samples",
"Number of MCMC samples:",
min = 11, max = 11111, value = 44),
shiny::h4(shiny::helpText(" Larger is better.")),
shiny::sliderInput("Number_of_MCMC_chains",
"Number of MCMC chains:",
min = 1, max = MCMC.chains.max, value = 1),
# MCMC seed -----
shiny::h4(shiny::helpText("The number is seed.")),
shiny::sliderInput("Number_of_MCMC_seed",
"seed to be passed to rstan::sampling():",
min = 1, max = 99999999, value = seed.initial.of.MCMC)
), #absolutePanel
shiny::sidebarLayout(
shiny::sidebarPanel(width = 5,
# wellPanel(
# shiny::h3("Trace plot"),
# radioButtons("stan_trace", "Trace plot", c("TRUE", "FALSE"))
# ),
# shiny::plotOutput("DrawCurves" ),
shiny::h1("Fitted curves"),
shiny::checkboxInput("DrawCFPCTP",
"FPF and TPF (Data)",
value = TRUE),
shiny::checkboxInput("DrawFROCcurve",
"FROC curve (Fitted model)",
value = TRUE),
shiny::checkboxInput("DrawAFROCcurve",
"AFROC curve (used for AUC) (Fitted model)",
value = FALSE),
# Curve Plot ----
shiny::plotOutput("DrawCurves", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
# Curve Plot Empirical----
# shiny::h6(shiny::helpText("Empirical curves")),
shiny::h1("Empirical Curves"),
shiny::plotOutput("DrawEmpiricalCurves", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
#
# shiny::em( "Modality ID"),
# shiny::h6(shiny::helpText("Specify the modality ID to be drawn")),
# shiny::checkboxInput("m1",
# "1st",
# value = TRUE),
#
#
#
#
#
#
#
#
#
# shiny::checkboxInput("m2",
# "2nd",
# value = FALSE),
#
#
# shiny::checkboxInput("m3",
# "3st",
# value = FALSE),
#
#
# shiny::checkboxInput("m4",
# "4nd",
# value = FALSE),
#
#
# shiny::checkboxInput("m5",
# "5st",
# value = FALSE),
#
#
# shiny::em( "Reader ID"),
# shiny::h6(shiny::helpText("Specify the Reader ID to be drawn")),
# shiny::checkboxInput("q1",
# "1st",
# value = TRUE),
#
# shiny::checkboxInput("q2",
# "2nd",
# value = FALSE),
#
#
# shiny::checkboxInput("q3",
# "3rd",
# value = FALSE),
#
#
#
# shiny::checkboxInput("q4",
# "4st",
# value = FALSE),
#
#
# shiny::checkboxInput("q5",
# "5st",
# value = FALSE),
#
#
#
shiny::wellPanel(
# divergent ----------------
shiny::h1("Check HMC diagnostics"),
shiny::h6("divergence"),
shiny::verbatimTextOutput("divergent_iterations_print"),
# treedepth ----------------
shiny::h6("treedepth"),
shiny::verbatimTextOutput("treedepth_print"),
shiny::h6("E-BFMI values "),
shiny::verbatimTextOutput("check_energy_print"),
shiny::h6("R hat"),
shiny::verbatimTextOutput("max_Rhat_print"),
shiny::br()
),
# save ----
shiny::h1("Save a fitted model object"),
shiny::actionButton("trigger_save_a_fitted_model_object","Save a fitted model object in Desktop"),
shiny::actionButton("trigger_save_a_fitted_model_object_working_directory","Save a fitted model object in Working directory"),
shiny::h6(shiny::helpText("* Put resulting file \"fit\" which has no extension in working directory of R and execute the code"), "load(\"fit\")", shiny::helpText(" from R console, then an R object named fit is available from R console. To change the S4 class to stanfit, use fitt <- methods::as(fit, \"stanfit\")")),
shiny::h4("Estimates"),
shiny::h6(shiny::helpText("Internet Environment is required for TeX script.")),
shiny::uiOutput("formula"),
shiny::wellPanel(
shiny::uiOutput("formula.TeX"),
shiny::uiOutput("formula.model"),
shiny::uiOutput("formula.AUC"),
shiny::uiOutput("formula.WAIC"),
shiny::uiOutput("formula.chisquare")
),#wellPanel
shiny::br()
# ,wellPanel(
# shiny::h3("Save"),
# actionButton("save", "Save table")
# )
# )
),#sidebarPanel
# shiny::column(6,
shiny::mainPanel(width = 7,
shiny::wellPanel(
shiny::h1("Statistics"),
shiny::verbatimTextOutput("AUC_ranking_print"),
# AUC Plot ----
shiny::plotOutput("AUC_CI", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
# trace_AUC ----
shiny::plotOutput("trace_AUC", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::h6(shiny::helpText(" Larger is better.")),
shiny::uiOutput("formula.AUC.without.TeX"),
shiny::h6(shiny::helpText("A number between 0 and 1, indicating observer performance.")),
shiny::h6(shiny::helpText("------------------------------------------------------------------------------------")),
shiny::h6(shiny::helpText(" Smaller is better.")),
shiny::uiOutput("formula.WAIC.without.TeX"),
shiny::h6(shiny::helpText("Evaluate whether our model is good.")),
shiny::h6(shiny::helpText("------------------------------------------------------------------------------------")),
shiny::h6(shiny::helpText(" Smaller is better.")),
shiny::uiOutput("formula.chisquare.without.TeX"),
shiny::uiOutput("EAP_of_chi_square"),
shiny::h6(shiny::helpText("A difference between data and expectations from estimates.")),
shiny::h6(shiny::helpText("------------------------------------------------------------------------------------")),
shiny::h6(shiny::helpText(" Larger is better.")),
shiny::em( shiny::uiOutput("ppp")),
shiny::h6(shiny::helpText(" Null hypothesis is that our model fit to the data well.")),
shiny::checkboxInput("ppp_calculate_trigger",
"Calculate P-value",
value = FALSE),
shiny::h6(shiny::helpText("It requires time."))
),
# shiny::h2(" FROC Curve and FPF,TPF"),
# shiny::h4(shiny::helpText("I love you :'-D If you love me, then employ me :)")),
# shiny::h4(shiny::helpText("In Hit rate plain, the canonical Gaussian is also drawn to show how the graph changes. ")),
# shiny::h4(shiny::helpText("In False rate plain, the signal Gaussian is also drawn to show how the graph changes. ")),
# shiny::h4(shiny::helpText("The thresholds are common between false alram and hit.")),
# shiny::h6(shiny::helpText("Internet Environment is required for TeX script.")),
shiny::plotOutput("bi_normal", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::plotOutput("false_rate", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::h6(shiny::helpText("The most right area corresponds the rate of the most high confidence.")),
shiny::checkboxInput("Colour_plot_of_rates",
"Colour",
value = TRUE),
shiny::checkboxInput("dark_theme",
"dark theme",
value = TRUE),
shiny::checkboxInput("mathmatical.symbols",
"What curve are drawn?",
value = TRUE),
shiny::sliderInput("density",
"density:",
min = 0, max = 100,
value = 23# Default
),
shiny::wellPanel(
# shiny::checkboxInput("FPF_per_Lesion",
# "FPF per Lesion",
# value = FALSE),
# per lesion or per image ----
shiny::selectInput("FPF_per_Lesion", "FPF",
c(
"False Positive Fraction per image (per trial)" = FALSE,
"False Positive Fraction per lesion (per signal, per nodule)" = TRUE
)
)
),#wellPanel
shiny::h2(" Posterior Estimates"),
shiny::h6(shiny::helpText(" mean = posterior mean")),
# shiny::h6(shiny::helpText(" se_mean = .... ")),
shiny::h6(shiny::helpText(" sd = Standard Deviation of posterior MCMC samples")),
shiny::h6(shiny::helpText(" 2.5% = Lower bound of Posterior Credible interval")),
shiny::h6(shiny::helpText(" 97.5% = Upper bound of Posterior Credible interval")),
shiny::h6(shiny::helpText(" Rhat = A criteria of Convergence for MCMC sampling, if it is more close to 1, then it is better. ")),
shiny::verbatimTextOutput("fit_print"),
shiny::h2(" Replicated FROC datasets to calculate a posterior predictive p value"),
shiny::checkboxInput("ppp_plot_trigger",
"Plot replicated datasets to calculate P-value",
value = FALSE),
shiny::h4(shiny::helpText("It requires time.")),
shiny::plotOutput("plot_ppp", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::checkboxInput("Colour",
"Colour",
value = FALSE),
shiny::checkboxInput("dark_theme_ppp",
"dark theme",
value = FALSE),
shiny::br()
)#mainPanel
)#sidebarLayout
),#tabPanel
shiny::tabPanel("Ref",
shiny::h2(" Reference:"),
shiny::h4(shiny::a( "See vignettes for more details", href="https://cran.r-project.org/package=BayesianFROC")),
shiny::h4(shiny::helpText(" Issei Tsunoda (2019): Pre-print; Bayesian Models for Free - Response Receiver Operating Characteristic Analysis.")),
shiny::h4(shiny::helpText(" Dev Chakraborty (1989) doi:10.1118/1.596358; Maximum likelihood analysis of free - response receiver operating characteristic (FROC) data.")),
shiny::h4(shiny::helpText(" Dev Chakraborty; Observer Performance Methods for Diagnostic Imaging, Foundations, Modeling, and Applications with R-Based Examples "))
),#tabPanel
shiny::tabPanel("stanmodel",
shiny::verbatimTextOutput("stanmodel_print"),
shiny::h4(shiny::helpText("This Stan code was written by Riyacobach Riyathoe and Ruikobach Sampota who are doggies, he was a champion in many sports such as ")),
shiny::h4(shiny::helpText("Best regards,")),
shiny::h4(shiny::a( "doggy", href="https://cran.r-project.org/package=BayesianFROC")),
# shiny::actionButton("Riya","RiyaSan"),
shiny::br()
),#tabPanel
shiny::tabPanel("Trace Plot",
shiny::actionButton("trigger_stan_trace_plot","Trace plot"),
# trace plot -----
shiny::plotOutput("plot_trace", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::h4(shiny::helpText("The author's older brother is biggy, his hiphop is very big hip! Piggy what are you doing, you still smoke in the water? Piggy is expert of chemistry, what are doing piggy, you still fat man? or big hip man?")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Piggy", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Histogram",
shiny::actionButton("trigger_stan_hist_plot","Histogram plot"),
# hist plot -----
shiny::plotOutput("plot_hist", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::sliderInput("hist_bins",
"Number of bins:",
min = 1, max = 777,
value = 30# Default
),
shiny::h4(shiny::helpText("The author's younger brother is rat, his teeth is outer and outer and outer. What are doing rat? you still work very hard position? He is also expert of chemistry, he did chemistry in his master degree. Ha, my brothers like chemisty. I cannot understand why chemistry is funny? I like Riemannian geometry. Are you happy now? You have a lot of money and a car, but you working eight days a week, is your own life? Oh, I got a call and he will marry, I cannot believe. So, he is happy, but me, I have aches. ha... ")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Rat", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Generic plot",
shiny::actionButton("trigger_stan_generic_plot","Trace plot"),
# generic plot -----
shiny::plotOutput("generic_plot", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::h4(shiny::helpText("The author's younger and younger brother is nothing but his pokemon is tiny, pratin.")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Pratin", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Cat",
shiny::h4(shiny::helpText("To tell the truth, I am not interest to FROC analysis, what I want is only healthy life forever. I do not write any program for FROC analysis! I hate all such people! ")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Cat", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Fish",
shiny::h4(shiny::helpText(" Why FROC, to tell the truth, I am not sure, but only things what I want to say is I do not want to ride a rice for Sushi! ")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Fish", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Carbus University",
shiny::h4(shiny::helpText(" I am a professor in both Carbus and Mosquitowbus univeristy
in which I study how to fight to mosquito in the
dark night. Mosquitos threaten me with his poooo00000000ooooooo0000000000ooooooooooo000000000000000ooooooon,
voice, so I try to catch them, but their stealth cannot
catch. I have to establish new theory how to fight them
to ensure our stable sleepping.
When I 17 years old, I establish the Carbus university and research how to fight Car ( which means mosquito in some language).
Yes, I am the fist president of Carbus university.
")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "The Author", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Ghostbus university",
shiny::h4(shiny::helpText(" I am a professor in the Ghostbus univeristy
in which I study how to fight to ghost. My studenta are the Ghostbusters.")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "The Author", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Acknowleage",
shiny::h4(shiny::helpText("This package is made with helps of many unknown people in stack over flows, and the author appreciate their kind helps. Also Stan developer gives me quick and appropriate advices in many times. Such many people helps me to develop this package. So, Michael Jackson says you are not alone!")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "The Author,", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Author",
shiny::h1(" Help!"),
shiny::h2(" The author: Issei Tsunoda <tsunoda.issei1111 _at_ gmail.com>"),
shiny::h3(" Employ me! :'-D, send me a mail <tsunoda.issei1111 _at_ gmail.com> I will go any country!"),
shiny::h5(" I am japanese and live in Japan, but if necessary,
I will go any country! Please help! I need somebody who employs me.
Help! Not just any body, HELP! I need someone! HEEEELP!
When I was younger so much, younger than today, I studied Riemannian Goematry.
But now and then, I feel that in mathematics I cannot obtain any result.
Help me if you can employ me in towns and I do apprecieate,..., I love the Beatles and Bach and Beethoven ( player is Wilhelm Kempf only), Aerothmith, John Lennon, Billy Joel, Ben E King,...etc.
"),
shiny::h5("Please employ me! :'-D Now, I have no job! I study differential geometry and
my most interest is complex differential geometry,
Kodaira-Spencer deformation theory, Gromov-Hausdorff topology, Ricci flow, mean curvature flow, Schubelt calculas. I want to go many nature place, not urban. In several month ago, my whole body has prurigo nodularis, so I hate sarfactant except bio-surfactant."),
shiny::h1("Multiple Chemical sensitivity (MCS)"),
shiny::h5("In a 2017, December, 28, My exposure to surfactant (I won't use, and never have used in my own life, it is required in my company) and other chemical materials in it, makes my body very bad condition that symptoms occur in multiple organ systems. In several hours later from the exposure, irritant darmatitis occured. During the first month from the exposure, my whole body has irritant stimulas, it is tiktik. And 14 month later from the exposure, my whole body has prurigo nodularis and other chronic conditions, in addition other disorders caused by the exposure are present in my body in now (18 months later from the exposure).
I am very sad since many people think it is psychogenic, but it is never such a thing, Complaints of MCS is very strong, should not dismissed as psychogenic. We shold not be kept waiting for development of the diagnosis. I suffer from chemical sensitivity.
All doctor who met me were lacking ability and didnot has any criteria of diagnosis for MCS.
"),
shiny::h5("Prurigos in My Mody"),
shiny::img(src="prurigo.jpg",height= "222", width="222"),
shiny::h1(" About my e-mail"),
shiny::h5(" I publish this package with my e-mail, then
spam mails comes.
When you sends me a mail, then please specify
some knowleage about mathematics ( Reimannian Geotmery or Kodaira Spencer theory) or FROC or Bayesian analysis.
Since my spam mails are all English, so I doubt English mails.
"),
shiny::h1(" About my package"),
shiny::h5(" I am not sure who is interest in my package,
Programming never finish forever,
so, ... I am tired."),
shiny::h1("Paper"),
shiny::h5(" My paper will publish soon.
I research some pure mathematical things about the Gromov Hausdorff topology
My heart is alwary with mathematics.
It is my destiny.
"),
shiny::h4(shiny::a( "R package BayesianFROC", href="https://cran.r-project.org/package=BayesianFROC"))
)#tabPanel
)#navbarPage
# )#shinyUI
# ))
#_____________________________------
server <- function(input, output) {
values <- shiny::reactiveValues()
# Data -----
shiny::observe({
if (!is.null(input$data_frame)) {
DF = rhandsontable::hot_to_r(input$data_frame)
} else {
if (is.null(values[["DF"]]))
DF <- DF
else
DF <- values[["DF"]]
}
values[["DF"]] <- DF
values[["dataList"]] <- list(NL=input$Number_of_lesions,
NI=input$Number_of_images,
h=DF$h,
f=DF$f,
c=DF$c,
m=DF$m,
q=DF$q,
M=max(DF$m),
Q=max(DF$q),
C=max(DF$c)
)
})
# Data_MQC -----
shiny::observe({
if (!is.null(input$data_frame_MQC)) {
DF_MQC = rhandsontable::hot_to_r(input$data_frame_MQC)
} else {
if (is.null(values[["DF_MQC"]]))
DF_MQC <- DF_MQC
else
DF_MQC <- values[["DF_MQC"]]
}
values[["DF_MQC"]] <- DF_MQC
})
# shiny::observeEvent(c( input$trigger_skeleton_of_data
# ), {
# counter$ssss <-c(counter$ssss, length( counter$ssss)+1)
# print(length( counter$ssss )==1)
# print( counter$ssss )
# })
#
# data ------
output$data_frame <- rhandsontable::renderRHandsontable({
DF <- values[["DF"]]
# if( length(counter$ssss) >3){
M <- values[["DF_MQC"]]$M
Q <- values[["DF_MQC"]]$Q
C <- values[["DF_MQC"]]$C
# h <- values[["dataList"]]$h
# f <- values[["dataList"]]$f
harray <- array_of_hit_and_false_alarms_from_vector( values[["dataList"]])$harray
farray <- array_of_hit_and_false_alarms_from_vector( values[["dataList"]])$farray
dimension <- dim(harray)
C_old <-dimension[1]
M_old <-dimension[2]
Q_old <-dimension[3]
harrayNew<-array(0,dim=c(C,M,Q));#Cumulative
farrayNew<-array(0,dim=c(C,M,Q));#Cumulative
for (cd in 1:C) {
for (md in 1:M) {
for (qd in 1:Q) {
if(cd <= C_old &&md <= M_old&&qd <= Q_old) harrayNew[cd,md,qd] <- harray[cd,md,qd]
if(cd > C_old ||md > M_old||qd > Q_old) harrayNew[cd,md,qd] <- NaN
if(cd <= C_old &&md <= M_old&&qd <= Q_old) farrayNew[cd,md,qd] <- farray[cd,md,qd]
if(cd > C_old ||md > M_old||qd > Q_old) farrayNew[cd,md,qd] <- NaN
}
}
}
h<-vector()
f<-vector()
for(md in 1:M) {
for(cd in 1:C) {
for(qd in 1 : Q){
f[cd+(md-1)*C*Q+(qd-1)*C]<-farrayNew[cd,md,qd]
h[cd+(md-1)*C*Q+(qd-1)*C]<-harrayNew[cd,md,qd]
}}}
mqc <- m_q_c_vector_from_M_Q_C(M,Q,C)
DF <- list(NL=input$Number_of_lesions,
NI=input$Number_of_images,
# h=rep(NaN, M*Q*C),
# f=rep(NaN, M*Q*C),
h=h,
f=f,
c=mqc$c,
m=mqc$m,
q=mqc$q,
M=M,
Q=Q,
C=C
)
if(M*Q*C <=30 && M*Q*C >5){ height <- M*Q*C*30 }
else if (M*Q*C <=30 && M*Q*C <=5 && M*Q*C >4){ height <- 120}
else if (M*Q*C <=30 && M*Q*C <=3){ height <- 1}
else {height <- 600}
DF <- extract_data_frame_from_dataList_MRMC(DF)
L <- length(DF)
comments_of_DF <- "Do not edit the cells in columns of modality, reader and rating by hands, instead, use the following GUIs to edit. The cells of hits and false alarms are editable cells by hands."
DF_comment <- data.frame( m= rep(comments_of_DF,( M*Q*C )),
q= rep(comments_of_DF,( M*Q*C )),
c= rep(comments_of_DF,( M*Q*C )),
h= rep(NA,( M*Q*C )),
# h= rep("test",( M*Q*C )),
f= rep(NA,( M*Q*C )) )
tableAAA<- rhandsontable::rhandsontable(DF,# width = 300,
height = height,
colHeaders = c( "Modality", "Reader","Rating","No. of Hits","No. of False Alarms"),
# enableComments=TRUE,#cause error , enableComments = !is.null(comments), ...) : formal argument "enableComments" matched by multiple actual arguments
comments =DF_comment,
stretchH = "all")
# tableAAA <- rhandsontable::hot_table(#decolartion for table
# tableAAA
# ,highlightCol = TRUE
# , highlightRow = TRUE#decolartion for table
# , stretchH = "all"
# # ,enableComments=TRUE#decolartion for table
# # ,rowHeaderWidth=88
# )
# for (columns in 1:3) {
# for (rows in 1:L) {
# tableAAA <- rhandsontable::hot_cell(tableAAA,
# row=rows,col=columns,
# readOnly = TRUE,
# comment = "Cannot edit by hand"
# )
#
# }
# }
tableBBB<- rhandsontable::hot_heatmap(tableAAA,
cols = c(1, 2, 3),
color_scale = c("#EBE4BC" , "#EDE7BE00" )
)# Table color cols <- colourpicker::colourPicker(5)
tableCCC<- rhandsontable::hot_heatmap(tableBBB,
cols = c(4,5),
color_scale = c("#FABBBB" , "#FABBBB1F" )
)# Table color cols <- colourpicker::colourPicker(5)
})
######### from here 2020 Aug
# Data MQC table ------
output$data_frame_MQC <- rhandsontable::renderRHandsontable({
DF_MQC <- values[["DF_MQC"]]
M <- DF_MQC$M
Q <- DF_MQC$Q
C <- DF_MQC$C
comments_of_DF <- "Editing this, the above table will change accordingly. Then edit the number of TPs FPs in the table to get own dataset.I Love you! \n Best regards, \n Doggy"
DF_comment <- data.frame( M=comments_of_DF,
Q=comments_of_DF,
C=comments_of_DF)
tableAAA<- rhandsontable::rhandsontable(DF_MQC,# width = 300,
# height = 20,
colHeaders = c("modality","reader","ratings"),
rowHeaders = NULL,
comments =DF_comment,
stretchH = "all")
tableCCC<- rhandsontable::hot_heatmap(tableAAA,
cols = c(1,2,3), color_scale = c("#FABBBB" , "#FABBBB")#"#FABBBB" , "#FABBBB1F" )
)# Table color cols <- colourpicker::colourPicker(5)
})
########### Up to here 2020 AUg
#Check -----
output$checkbox_GUI_Readers <- shiny::renderUI({
shiny::checkboxGroupInput("R_object_as_the_result_of_check_boxes_for_reader",
"Select Reader ID",
choices = seq(1:max(values[["dataList"]]$q)),
select =c(1,max(values[["dataList"]]$q)) # This specify the initial condition
)
})
output$txt_user_specifies_reader_IDs <- shiny::renderText({
icons <- paste(input$R_object_as_the_result_of_check_boxes_for_reader, collapse = ", ")
paste("Selected reader IDs:", icons)
})
output$checkbox_GUI_Modality <- shiny::renderUI({
shiny::checkboxGroupInput("R_object_as_the_result_of_check_boxes_for_modality",
"Select modality ID",
choices = seq(1:max(values[["dataList"]]$m)),
select =c(1,max(values[["dataList"]]$m)) # This specify the initial condition
)
})
output$txt_user_specifies_Modality_IDs <- shiny::renderText({
icons <- paste(input$R_object_as_the_result_of_check_boxes_for_modality, collapse = ", ")
paste("Selected modality IDs:", icons)
})
# This is use such as fit() instesad of fit
fit <- shiny::reactive({
# fit ----
fit <- BayesianFROC::fit_Bayesian_FROC(
# ite = 111,
print_CI_of_AUC = FALSE,
ite = input$Number_of_MCMC_samples,
see = input$Number_of_MCMC_seed,
cha = input$Number_of_MCMC_chains,
ModifiedPoisson = as.logical(input$FPF_per_Lesion),
summary = TRUE,
# Null.Hypothesis = FALSE,
dataList = values[["dataList"]],# input$selected_data ,
DrawCurve = F
# dig = 5,
# prior = as.integer(input$prior)
)
return(fit)
})
## Save
# shiny::observeEvent(input$save, {
# finalDF <- isolate(values[["DF"]])
# # saveRDS(finalDF, file=file.path(outdir, sprintf("%s.rds", outfilename)))
#
#
#
#
#
# })
# TeX data -----
output$formula <- shiny::renderUI({
# my_calculated_value <- extractAUC(fit(),dig = 4)[1]
C<-values[["dataList"]]$C
z<-apply( extract(fit())$z , 2, mean)
m <- mean( extract(fit())$m)
v <- mean( extract(fit())$v)
s<-"Posterior Mean of Model Parameters: "
for (cd in 1:C){
s<-paste0(s," $$z_",cd," = ",signif(z[cd],digits = 3),",$$")
}
s<-paste0(s," $$\\mu = ",signif(m,digits = 3),",$$")
s<-paste0(s," $$\\sigma = ",signif(v,digits = 3),",$$")
shiny::withMathJax(s)
})
output$formula.model <- shiny::renderUI({
# my_calculated_value <- extractAUC(fit(),dig = 4)[1]
C<-values[["dataList"]]$C
Q<-values[["dataList"]]$Q
M<-values[["dataList"]]$M
NL<-values[["dataList"]]$NL
NI<-values[["dataList"]]$NI
# h<-values[["dataList"]]$h
# f<-values[["dataList"]]$f
# c<-values[["dataList"]]$c
d <-metadata_to_fit_MRMC(values[["dataList"]])
h<-d$harray
f<-d$farray
# h_rev <- rev(h)
# f_rev <- rev(f)
z<-apply( extract(fit())$z , 2, mean)
# p<-apply( extract(fit())$p , 2, mean)
ppp<-apply( extract(fit())$ppp , c(2,3,4), mean)
dl<-apply( extract(fit())$dl , 2, mean)
m <- mean( extract(fit())$m)
v <- mean( extract(fit())$v)
c<-C:1
s<-"Posterior Mean of Model Parameters: "
for (cd in 1:C){
s<-paste0(s," $$z_",cd," = ",signif(z[cd],digits = 3),",$$")
}
s<-paste0(s," $$\\sigma = ",signif(v,digits = 3),",$$")
s<-paste0(s," $$\\mu = ",signif(m,digits = 3),",$$")
s<-paste0(s," * In the following, the subscripts means level of confidence, modality ID, reader ID, respectively. ")
for (qd in 1:Q){
for (md in 1:M){
for (cd in 1:C){
s<-paste0(s," $$H_{",cd,",",md,",",qd,"} \\sim \\text{Binomial}(",signif(ppp[cd,md,qd],digits = 3),",", NL,"), \\text{ the realization is } H_{",cd,",",md,",",qd,"} = ",h[C-cd+1,md,qd] ," .$$")
}}
}
for (cd in 1:C){
s<-paste0(s," $$F_{",cd,", m, r} \\sim \\text{Poisson}(",signif(dl[cd]*NI,digits = 3),"), \\text{for all } m = 1,...,",M," \\text{ and for all } r = 1,...,",Q,"$$")
}
for (qd in 1:Q){
for (md in 1:M){
for (cd in 1:C){
s<-paste0(s," $$F_{",cd,",",md,",",qd,"} \\sim \\text{Poisson}(",signif(dl[cd]*NI,digits = 3),"), \\text{ the realization is } F_{",cd,",",md,",",qd,"} = ",f[C-cd+1,md,qd] ," .$$")
}}
}
shiny::withMathJax(s)
})
# TeX ------
output$formula.AUC <- shiny::renderUI({
# C<-values[["dataList"]]$C
# NL<-values[["dataList"]]$NL
# NI<-values[["dataList"]]$NI
C<-values[["dataList"]]$C
Q<-values[["dataList"]]$Q
M<-values[["dataList"]]$M
# z<-apply( extract(fit())$z , 2, mean)
# p<-apply( extract(fit())$p , 2, mean)
# dl<-apply( extract(fit())$dl , 2, mean)
#
# m <- mean( extract(fit())$m)
# v <- mean( extract(fit())$v)
# a <- mean( extract(fit())$a)
# b <- mean( extract(fit())$b)
a<-apply( extract(fit())$aa , c(2,3), mean)
b<-apply( extract(fit())$bb , c(2,3), mean)
a <- signif(a,digits = 3)
b <- signif(b,digits = 3)
# bb <- signif(b^2,digits = 3)
AA<-apply( extract(fit())$AA , c(2,3), mean)
AA <- signif(AA,digits = 3)
s<-"* In the following, the Posterior Mean of AUC for each modality and each reader are calculated. "
# c<-C:1
for (qd in 1:Q){
for (md in 1:M){
s<-paste0(s," $$\\text{AUC}_{",md,",",qd,"}= \\Phi (\\frac{\\hat{a}_{",md,",",qd,"}}{\\sqrt{1+\\hat{b_{",md,",",qd,"}}^2}})=\\Phi (\\frac{",a[md,qd],"}{\\sqrt{1+",b[md,qd],"^2}}) = ",AA[md,qd],"$$ where estimates are posterior mean.")
}}
A<-apply( extract(fit())$A , 2, mean)
A <- signif(A,digits = 3)
s<- paste0(s,"Posterior Mean of AUC for each modality")
# c<-C:1
for (md in 1:M){
s<-paste0(s," $$\\text{AUC}_{",md,"}= \\frac{1}{",Q,"} \\Sigma_{r=1}^{",Q,"} AUC_{",md,",r} = ",A[md],"$$ where estimates are posterior mean.")
}
# AUC TeX -------
shiny::withMathJax(s)
})
# TeX ------
output$formula.WAIC <- shiny::renderUI({
WAIC <- fit()@WAIC
WAIC <- signif(WAIC,digits = 3)
s<-paste0(" $$\\text{WAIC} = ",WAIC,".$$")
shiny::withMathJax(s)
})
# TeX ------
output$formula.chisquare <- shiny::renderUI({
chisquare <- fit()@chisquare
chisquare <- signif(chisquare,digits = 3)
s<-paste0(" $$\\chi^2(\\text{data}|\\widehat{\\theta}) = ",chisquare,"$$ where estimates \\( \\widehat{ \\theta }\\) are at posterior mean of model parameters \\( \\theta \\).")
shiny::withMathJax(s)
})
# TeX ------
output$formula.TeX <- shiny::renderUI({
s<-paste0(" To show \\( \\TeX \\), internnet environment is required.")
shiny::withMathJax(s)
})
# output$formula.AUC.without.TeX <- shiny::renderUI({
# # C<-values[["dataList"]]$C
# # NL<-values[["dataList"]]$NL
# # NI<-values[["dataList"]]$NI
# #
# # z<-apply( extract(fit())$z , 2, mean)
# # p<-apply( extract(fit())$p , 2, mean)
# # dl<-apply( extract(fit())$dl , 2, mean)
# #
# # m <- mean( extract(fit())$m)
# # v <- mean( extract(fit())$v)
#
# a <- mean( extract(fit())$a)
# b <- mean( extract(fit())$b)
# a <- signif(a,digits = 3)
# b <- signif(b,digits = 3)
# # bb <- signif(b^2,digits = 3)
#
#
#
# A <- mean( extract(fit())$A)
# A <- signif(A,digits = 3)
#
# # c<-C:1
#
# s<-paste0("AUC = ",A)
# shiny::withMathJax(s)
# })
output$formula.WAIC.without.TeX <- shiny::renderUI({
WAIC <- fit()@WAIC
WAIC <- signif(WAIC,digits = 3)
s<-paste0(" WAIC = ",WAIC)
shiny::withMathJax(s)
})
output$formula.chisquare.without.TeX <- shiny::renderUI({
chisquare <- fit()@chisquare
chisquare <- signif(chisquare,digits = 3)
s<-paste0("chi square at posterior mean = ",chisquare)
shiny::withMathJax(s)
})
# ppp ------
output$ppp <- shiny::renderUI({
if (input$ppp_calculate_trigger) {
#
# ppp <- signif(ppp,digits = 3)
#
# if (ppp>=0.05) s<-paste0("Posterior Predictive P value = ",ppp)
# if (ppp< 0.05) s<-paste0("Posterior Predictive P value = ",ppp," *")
# if (ppp< 0.01) s<-paste0("Posterior Predictive P value = ",ppp," **")
#
}
if (!input$ppp_calculate_trigger) s<-paste0("Posterior Predictive P value is not calculated")
s<-paste0("Posterior Predictive P value is not calculated (Under construction)")
shiny::withMathJax(s)
})
output$EAP_of_chi_square <- shiny::renderUI({
# ppp <- ppp_srsc(fit())$p.value
# Chi.Square.for.each.MCMC.samples <- chi_square_goodness_of_fit(fit() )
Chi.Square.for.each.MCMC.samples <- Chi_square_goodness_of_fit_in_case_of_MRMC_Posterior_Mean(fit() )
m<- mean(Chi.Square.for.each.MCMC.samples$chi.square)
m <- signif(m,digits = 3)
s<-paste0("Posterior mean of chi square = ",m)
shiny::withMathJax(s)
})
# output$formula <- renderUI({
# my_calculated_value <- extractAUC(fit(),dig = 4)[1]
# withMathJax(paste0("Posterior mean of AUC (area under the AFROC curve): $$\\widehat{AUC} =", my_calculated_value,"$$"))
# })
output$fit_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fitt <-methods::as(fit(), "stanfit")
# print( fitt, digits = 4)
a<- summary(fitt,probs=c(0.025,0.975))$summary
print(a)
# }# if
#
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# counter -----
counter <- shiny::reactiveValues()
shiny::observeEvent(c(input$trigger_stan_trace_plot
# ,input$hot
), {
counter$s <-c(counter$s, length( counter$s)+1)
})
shiny::observeEvent(c( input$trigger_stan_hist_plot
# input$hist_bins
), {
counter$ss <-c(counter$ss, length( counter$ss)+1)
})
shiny::observeEvent(c( input$trigger_stan_generic_plot
# input$hist_bins
), {
counter$sss <-c(counter$sss, length( counter$sss)+1)
})
# shiny::observeEvent(c( input$trigger_skeleton_of_data
# # input$hist_bins
# ), {
# counter$ssss <-c(counter$ssss, length( counter$ssss)+1)
# })
# trace--------
output$plot_trace <- shiny::renderPlot({
if (input$trigger_stan_trace_plot) {
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
print(paste( "s = ", length(counter$s) ) )
if(floor(length(counter$s) /2)==length(counter$s) /2){
if ( check_hit_is_less_than_NL(values[["dataList"]]) ) {
fit <- fit()
message("Now, we plot trace of MCMC ....")
return(rstan::stan_trace(fit,pars = c("lp__")))
}
if ( !check_hit_is_less_than_NL(values[["dataList"]]) ) {
error_message(h,NL)
}#if
}
}else if (!input$trigger_stan_trace_plot||!floor(length(counter$s) /2)==length(counter$s) /2) {
message("Now, we omit trace of MCMC ....")
return( plot(0,0,type="n", axes = TRUE,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="",ylab="",main="")
)
}
})#shiny::renderPlot 2020 march 12
# hist ------
output$plot_hist <- shiny::renderPlot({
if (input$trigger_stan_hist_plot) {
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
print(paste( "ss = ", length(counter$ss) ) )
if(floor(length(counter$ss) /2)==length(counter$ss) /2){
if ( check_hit_is_less_than_NL(values[["dataList"]]) ) {
fit <- fit()
message("Now, we plot trace of MCMC ....")
return(rstan::stan_hist (fit,pars = c("A"),bins=input$hist_bins))
}
if (! check_hit_is_less_than_NL(values[["dataList"]]) ) {
# error_message(h,NL)
plot(0,0,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="Please fix inconsistent data",ylab="",main="Error: Inconsistent Data \n In baseball game, \n batter's number of hits can not be greater than his number of at-bats")
graphics::text(0.5,0.8,c("*Now, Sum of the number of hits is greater than that of lesions; \n\n", expression(paste(h1+h2+h3+... , " > Number of Lesions")) ),col="white",cex = 1.4 )
}#if
}
}else if (!input$trigger_stan_trace_plot||!floor(length(counter$ss) /2)==length(counter$ss) /2) {
message("Now, we omit trace of MCMC ....")
return( plot(0,0,type="n", axes = TRUE,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="",ylab="",main="")
)
}
})#shiny::renderPlot
output$stanmodel_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
# print(prior_print_srsc(input$prior))
print(fit()@stanmodel)
# }# if
#
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
output$prior_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
# print(prior_print_srsc(input$prior))
prior_print_srsc(input$prior)
# }# if
#
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# max_Rhat_print -----
output$max_Rhat_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fit <-fit()
fitt <- methods::as(fit,"stanfit")
max.rhat <- round( max(summary(fitt)$summary[,"Rhat"]) ,digits = 5)
print(paste("max R-hat = ", max.rhat))
# }# if
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# divergent_iterations_print -----
output$divergent_iterations_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fit <-fit()
fitt <- methods::as(fit,"stanfit")
divergent <- rstan::get_divergent_iterations(fitt)
n <- sum(divergent)
N <- length(divergent)
if(!n==0) print(paste( n, " of ", N, "iterations ended with a divergence.",n,"/",N,"=", round( n/N ,digits = 2)))
if(n==0) print(paste( ":) OK"))
# }# if
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# treedepth_print -----
output$treedepth_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fit <-fit()
fitt <- methods::as(fit,"stanfit")
max_depth <- get_treedepth_threshold(fitt)
treedepths <- rstan::get_max_treedepth_iterations(fitt)
n <- sum(treedepths)
N <- length(treedepths)
if(!n==0) print(paste( n, " of ", N, "iterations saturated the maximum tree depth of.", max_depth,"."))
if(n==0) print(paste( ":) OK"))
# print("Not done ........... because get_treedepth_threshold is not an exported object from 'namespace:rstan' and hence the author omitted the evaluation from here. ")
# }# if
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# check_energy_print -----
output$check_energy_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fit <-fit()
fitt <- methods::as(fit,"stanfit")
EBFMIs <- get_bfmi(fitt)
bad_chains <- which(EBFMIs < 0.2)
if (!length(bad_chains)) {
# print("E-BFMI indicated no pathological behavior.")
print(paste( ":) OK"))
}
else {
print(paste("E-BFMI indicated possible pathological behavior:\n"
," Chain %s: E-BFMI = %.3f\n", bad_chains,
EBFMIs[bad_chains], "E-BFMI below 0.2 indicates you may need to reparameterize your model."))
}
# }# if
#
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# save a fitted model in Desktop ----
shiny::observeEvent(input$trigger_save_a_fitted_model_object,{
fit <- fit()
save( fit,file =paste0(file.path(Sys.getenv("USERPROFILE"),"Desktop"),"\\fit") )
# save( fit,file ="fit" )
tcltk::tkmessageBox(message=paste("\n* A file (name: \"fit\") is created in Desktop. In the file, an fitted model R object (name \"fit\") is contained, which is an object of an S4 class (stanfitExtended)\n\n\n 1) Put the resulting file \"fit\" in the working directory,\n 2) Run an R script \n load(\"fit\") \n\n then the R object named \"fit\" is available on your R console. "))
} )
# save a fitted model in Working directory ----
shiny::observeEvent(input$trigger_save_a_fitted_model_object_working_directory,{
fit <- fit()
save( fit,file ="fit" )
tcltk::tkmessageBox(message=paste("\n* A file (name: \"fit\") is created in the current working directory. In the file, an fitted model R object (name \"fit\") is contained, which is an object of an S4 class (stanfitExtended)\n\n\n 1) Put the resulting file \"fit\" in the working directory,\n 2) Run an R script \n load(\"fit\") \n\n then the R object named \"fit\" is available on your R console. "))
} )
# AUC_ranking_print -----
output$AUC_ranking_print <- shiny::renderPrint({
# h<-values[["dataList"]]$h
# NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
# fitt <-methods::as(fit(), "stanfit")
# print( fitt, digits = 4)
# a<- summary(fitt,probs=c(0.025,0.975))$summary
# print(sortAUC(fit()))
sortAUC(fit())
# }# if
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# Plor curve -----
output$DrawCurves <- shiny::renderPlot({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
M<-values[["dataList"]]$M
Q<-values[["dataList"]]$Q
# if (sum(h)<=NL) {
# grDevices::dev.off()
# grDevices::dev.set()
if (input$dark_theme==TRUE) { # This cords clear plot environment in shiny GUI board.
dark_theme();
plot(0,0, # Dumy plot to clean plot environment, this is required only Shiny board, I do not know the reason.
type="n",
axes=FALSE,
xlim=c(0,1),
ylim =c(0,1),
xaxt="n",
yaxt="n",
xlab="",
ylab="")
}
if(check_hit_is_less_than_NL(values[["dataList"]] ) ){
DrawCurves(fit(),
# Colour = FALSE,
Colour = input$dark_theme,
readerID = as.integer(input$R_object_as_the_result_of_check_boxes_for_reader),
modalityID = as.integer(input$R_object_as_the_result_of_check_boxes_for_modality),
new.imaging.device = FALSE,
DrawCFPCTP = input$DrawCFPCTP,
DrawFROCcurve = input$DrawFROCcurve,
DrawAFROCcurve = input$DrawAFROCcurve)
# }
}
if(!check_hit_is_less_than_NL(values[["dataList"]] ) ){
# if (sum(h)> NL) {
#
# h.string <- as.character(h)
# for (cd in 1:length(h.string)) {
# if (cd==1){ s<-""; s <- paste(h.string[cd],sep = "+")}
# if ( !cd==1)s <- paste(s,h.string[cd],sep = "+")
#
# }#for
# sum.of.h <- s
# sum.of.h <- paste(sum.of.h,"=",as.character( sum(h) ) )
#
plot(0,0,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="Please fix inconsistent data",ylab="",main="Error: Inconsistent Data \n In baseball game, \n batter's number of hits can not be greater than his number of at-bats")
#
graphics::text(0.5,0.8,c("*Now, Sum of the number of hits is greater than that of lesions; \n\n", expression(paste(h1+h2+h3+... , " > Number of Lesions")) ),col="white",cex = 1.4 )
# graphics::text(0.5,0.65,paste("In the current inputed data, it is the following: " ),col="black",cex = 1.5 )
# graphics::text(0.5,0.5,paste( sum.of.h , " > ",NL,sep = ""),col="red",cex = 2)
#
# graphics::text(0.5,0.3,c("* Please fix so that the following inequality holds \n", expression(paste(h1+h2+h3+... , " < Number of lesions"))),col="blue",cex = 1.5 )
# graphics::text(0.5,0.1,c("* Shoud decrease the number of hits or \n Shoud increase the number of lesions"),col="blue",cex = 1.5 )
#
#
#
}
# }#if
})#shiny::renderPlot
# plot curve Empirical-----
# Plor curve -----
output$DrawEmpiricalCurves <- shiny::renderPlot({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
M<-values[["dataList"]]$M
Q<-values[["dataList"]]$Q
# if (sum(h)<=NL) {
# grDevices::dev.off()
# grDevices::dev.set()
if (input$dark_theme==TRUE) { # This cords clear plot environment in shiny GUI board.
dark_theme();
plot(0,0, # Dumy plot to clean plot environment, this is required only Shiny board, I do not know the reason.
type="n",
axes=FALSE,
xlim=c(0,1),
ylim =c(0,1),
xaxt="n",
yaxt="n",
xlab="",
ylab="")
}
if(check_hit_is_less_than_NL(values[["dataList"]] ) ){
plot_empirical_FROC_curves(fit()@dataList,
ModifiedPoisson = as.logical(input$FPF_per_Lesion),
readerID = as.integer(input$R_object_as_the_result_of_check_boxes_for_reader),
modalityID = as.integer(input$R_object_as_the_result_of_check_boxes_for_modality),
)
# }
}
if(!check_hit_is_less_than_NL(values[["dataList"]] ) ){
# if (sum(h)> NL) {
#
# h.string <- as.character(h)
# for (cd in 1:length(h.string)) {
# if (cd==1){ s<-""; s <- paste(h.string[cd],sep = "+")}
# if ( !cd==1)s <- paste(s,h.string[cd],sep = "+")
#
# }#for
# sum.of.h <- s
# sum.of.h <- paste(sum.of.h,"=",as.character( sum(h) ) )
#
plot(0,0,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="Please fix inconsistent data",ylab="",main="Error: Inconsistent Data \n In baseball game, \n batter's number of hits can not be greater than his number of at-bats")
#
graphics::text(0.5,0.8,c("*Now, Sum of the number of hits is greater than that of lesions; \n\n", expression(paste(h1+h2+h3+... , " > Number of Lesions")) ),col="white",cex = 1.4 )
# graphics::text(0.5,0.65,paste("In the current inputed data, it is the following: " ),col="black",cex = 1.5 )
# graphics::text(0.5,0.5,paste( sum.of.h , " > ",NL,sep = ""),col="red",cex = 2)
#
# graphics::text(0.5,0.3,c("* Please fix so that the following inequality holds \n", expression(paste(h1+h2+h3+... , " < Number of lesions"))),col="blue",cex = 1.5 )
# graphics::text(0.5,0.1,c("* Shoud decrease the number of hits or \n Shoud increase the number of lesions"),col="blue",cex = 1.5 )
#
#
#
}
# }#if
})#shiny::renderPlot
# AUC plot -----
output$AUC_CI <- shiny::renderPlot({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
M<-values[["dataList"]]$M
Q<-values[["dataList"]]$Q
# if (sum(h)<=NL) {
# grDevices::dev.off()
# grDevices::dev.set()
if (input$dark_theme==TRUE) { # This cords clear plot environment in shiny GUI board.
dark_theme();
plot(0,0, # Dumy plot to clean plot environment, this is required only Shiny board, I do not know the reason.
type="n",
axes=FALSE,
xlim=c(0,1),
ylim =c(0,1),
xaxt="n",
yaxt="n",
xlab="",
ylab="")
}
nnname <- vector()
for (md in 1:M) {
nnname[md] <-paste("A[",md,"]",sep = "")
}
print( rstan::plot(methods::as(fit(), "stanfit"),par=nnname))
# extractAUC( fit() ,print_CI_of_AUC = TRUE, new.imaging.device = FALSE)
})#shiny::renderPlot
# trace plot for AUC trace_AUC -----
output$trace_AUC <- shiny::renderPlot({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
M<-values[["dataList"]]$M
Q<-values[["dataList"]]$Q
# if (sum(h)<=NL) {
# grDevices::dev.off()
# grDevices::dev.set()
if (input$dark_theme==TRUE) { # This cords clear plot environment in shiny GUI board.
dark_theme();
plot(0,0, # Dumy plot to clean plot environment, this is required only Shiny board, I do not know the reason.
type="n",
axes=FALSE,
xlim=c(0,1),
ylim =c(0,1),
xaxt="n",
yaxt="n",
xlab="",
ylab="")
}
nnname <- vector()
for (md in 1:M) {
nnname[md] <-paste("A[",md,"]",sep = "")
}
print( rstan::stan_trace(methods::as(fit(), "stanfit"),par=nnname))
# extractAUC( fit() ,print_CI_of_AUC = TRUE, new.imaging.device = FALSE)
})#shiny::renderPlot
}
## run app
shiny::runApp(list(ui=ui, server=server))
return(invisible())
}
Try the BayesianFROC package in your browser
Any scripts or data that you put into this service are public.
BayesianFROC documentation built on Jan. 23, 2022, 9:06 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.
Defines functions fit_GUI_Shiny_MRMC
Documented in fit_GUI_Shiny_MRMC
#' @title Fit with GUI via Shiny (in case of MRMC)
#' @description
#' Fit a Bayesian model with GUI.
#'
#' Revised 2019 Nov.
#'
#'
#' @details
#' In what follows, we assume that our dataset has more than two readers or modalities,
#' namely, our dataset is MRMC case.
#' The term \emph{imaging modality},
#' we mean a set of imaging methods such as MRI, CT, PET, etc.
#'
#'
#' Revised 2019 Nov 25.
#' Revised 2020 Jan
#' @param DF A dataframe, cosisting of five vectors: reader ID, modality ID, confidence levels, hits, false alarms.
#'
#' initial data to be fited
# @param outdir I use \code{ system.file("myapp", package = "BayesianFROC") }
# @param outfilename I do not know :'-D
#' @param NL.max max number of bins indicating the maximal number in which the number of lesions can move
#' @param NI.max max number of bins indicating the maximal number in which the number of imagegs can move
#' @param NL.initial Natural number indicating the initial number of lesions, Default value =142.
#' @param NI.initial Natural number indicating the initial number of images, Default value =199.
#' @param MCMC.chains.max max number of bins indicating number of MCMC chains
#' @param seed.initial.of.MCMC positive integers indicating the initial seed of MCMC sampling. Default is 1234.
#' @param DF_MQC A data frame, consisting of three numbers, i.e., the number of modalities, readers, confidence levels. Of course, these numbers should be compatible with the variable \code{DF}.
#' @return None
#' @export
#@examples-------
#' @examples
#'
#' \dontrun{
#'
#'#'## Only run examples in interactive R sessions
#'if (interactive()) {
#'#========================================================================================
#'# 1) Use the default User Interface
#'#========================================================================================
#'#'
#'
#' #No need to consider the variables, it is sufficient in default values.
#'
#'
#' fit_GUI_Shiny()
#'
#'
#'
#'
#'#========================================================================================
#'# 2) From exsisting dataset, named dddddd or ddddd or ddd
#'#========================================================================================
#'
#'
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(dddddd))
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(ddddd))
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(ddd))
#'
#'
#'
#'
#'#========================================================================================
#'# 2) data of 11 readers and a single modality
#'#========================================================================================
#'
#'
#'
#' d <- dataset_creator_for_many_Readers(1,11)
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(d))
#'
#'
#'
#'
#'
#'
#'
#'
#'
#'
#'#========================================================================================
#'# see = 2345678 convergence 37readers, 1 modality
#'#========================================================================================
#'
#'
#'
#' v <- v_truth_creator_for_many_readers_MRMC_data(M=1,Q=37)
#' m <- mu_truth_creator_for_many_readers_MRMC_data(M=1,Q=37)
#' d <- create_dataList_MRMC(mu.truth = m,v.truth = v)
#'
#'
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(d),
#' seed.initial.of.MCMC = 2345678,
#' NL.initial = d$NL,
#' NI.initial = d$NI)
#'
#'
#'
#'
#'
#'
#'
#'
#'#========================================================================================
#'# 2) From exsisting dataset, named dddd
#'#========================================================================================
#'
#'
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(dddd))
#'
#'
#' # This dataset named dddd is a dataset consisting of
#' # only a single reader and mutiple modality.
#' # Such a single reader and mutiple modality case had error caused
#' # by some reduction of array to vector.
#' # So, the program was fixed so that such special case is also available
#' # 2020 Feb 24
#'
#' # To reflect the information of the number of lesions and images,
#' # use the following.
#'
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(dddd),
#' NL.initial = dddd$NL,
#' NI.initial = dddd$NI)
#'
#'
# ####1#### ####2#### ####3#### ####4#### ####5#### ####6#### ####7#### ####8#### ####9####
#'#========================================================================================
#'# example
#'#========================================================================================
#'
#'
#'
#'
#' v <- v_truth_creator_for_many_readers_MRMC_data(M=2,Q=7)
#' m <- mu_truth_creator_for_many_readers_MRMC_data(M=2,Q=7)
#' d <- create_dataList_MRMC(mu.truth = m,v.truth = v)
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(d))
#'
#'
#'
# ####1#### ####2#### ####3#### ####4#### ####5#### ####6#### ####7#### ####8#### ####9####
#'#========================================================================================
#'# non-convergent example
#'#========================================================================================
#'
#'
#' v <- v_truth_creator_for_many_readers_MRMC_data(M=3,Q=7)
#' m <- mu_truth_creator_for_many_readers_MRMC_data(M=3,Q=7)
#' d <- create_dataList_MRMC(mu.truth = m,v.truth = v)
#' fit_GUI_Shiny_MRMC(DF=extract_data_frame_from_dataList_MRMC(d),seed.initial.of.MCMC = 23)
#'
#'
#'
#'
#'}### Only run examples in interactive R sessions
#'
#'
#'}
#'
fit_GUI_Shiny_MRMC <- function(
# Initial data -----
DF=data.frame(
m=as.integer(BayesianFROC::dd$m),
q=as.integer(BayesianFROC::dd$q),
c=as.integer(BayesianFROC::dd$c),
h=as.integer(BayesianFROC::dd$h),
f=as.integer(BayesianFROC::dd$f)
),
DF_MQC = data.frame(M=max(DF$m),
Q=max(DF$q),
C=max(DF$c)
),
# DF = dd,
NL.max=1111,
NI.max=1111,
#NL.initial ----
NL.initial = 142,
NI.initial = 199,
seed.initial.of.MCMC=237410,
# MCMC.samples.max = 11111,
MCMC.chains.max=4
# counter=0
){
outdir <- system.file("myapp", package = "BayesianFROC")
outfilename <- "table"
if (outdir == "") {
stop("Could not find myapp. Try re-installing `BayesianFROC`.", call. = FALSE)
}
# shiny::shinyUI(
# shiny::fluidPage(
ui <- shiny::navbarPage("Emplooooo\\(^o^)/oooooooy me! :'-D",
shiny::tabPanel(":) :-'D",
# shiny::tags$head(
# shiny::tags$link(rel = "stylesheet", type = "text/css", href = "styles.css")
# # , shiny::tags$script(src= "color_change.js")
# ) ,# Color
# CSS -----
shiny::tags$head(
shinythemes::themeSelector(),
shiny::tags$style(shiny::HTML("
/*Dragabble panel style heeeeeehaaaaaa*/
.ui-draggable {
z-index: 11;
background-color:#B0A9A9;
font-size: 14pt;
border-top: 1px solid #991313; border-bottom: 5px solid 991313; border-radius: 23px; border: 3px solid white;
}
/*Slider_input From here heeehaaaa*/
.irs-single {font-family: 'arial'; color:#B30E0E; background:#E0D162; font-size:17pt; }
.irs-slider {width: 65px; height: 60px; top: 35px; background:#870C0C; border-radius: 100px;}
.irs-max {font-family: 'arial'; color: black; background:#9E9898; font-size: 14pt}
.irs-min {font-family: 'arial'; color: black; background:#9E9898; font-size: 14pt}
.irs-bar { width: 100%; height: 15px; background: #991313; border-top: 1px solid #2e6da4; border-bottom: 1px solid black; border-radius: 33px; border: 1px solid #2e6da4; }
.irs-bar-edge { width: 40px; height: 15px; background: #991313; border-top: 1px solid #2e6da4; border-bottom: 1px solid black; border-radius: 33px; border: 1px solid #2e6da4; }
.irs-line { height: 15px; border-radius: 33px;border: 1px solid black; }
.irs-grid-pol {display: none;}
/*Slider_input From here heeehaaaa*/
.checkbox { /* checkbox is a div class*/
line-height: 30px;
margin-bottom: 40px; /*set the margin, so boxes don't overlap*/
font-size:17pt;
background:#C2C2C2;
color:black;/* font color*/
border-radius: 100px;
}
input[type='checkbox']{ /* style for checkboxes */
width: 32px; /*Desired width*/
height: 32px; /*Desired height*/
line-height: 32px;
}
span {
margin-left: 15px; /*set the margin, so boxes don't overlap labels*/
line-height: 20px;
}
"))
),#taghead #cols <- colourpicker::colourPicker(5) "#CC5858" #FF8800 "#B0A9A9" "#B8940263" "#70BBC7" "#C29999" #F07878 #E8906D9B #CCCCFF #9DCDD1 #F26666 background-color: #CCCCCF;
shiny::titlePanel(" FROC Analysis by Issei Tsunoda "),
shiny::h4(shiny::helpText("Change Data, then estimates and plotted curves are fitted accordingly. Enjoy fitting the FROC model to various datasets! Cheers! Pretty crowd!")),
# shiny::fluidRow(
# column(6, # shiny::h2(" FROC Data"),
#checkbox vectors of modalty ID, reader ID-------
shiny::absolutePanel( draggable = TRUE, style ="red",fixed=TRUE,
shiny::h1("Specify IDs"),
shiny::h6(shiny::helpText("Specified IDs will be plotted")),
shiny::uiOutput("checkbox_GUI_Readers"),
shiny::textOutput("txt_user_specifies_reader_IDs"),
shiny::uiOutput("checkbox_GUI_Modality"),
shiny::textOutput("txt_user_specifies_Modality_IDs"),
),
# Data -----
shiny::absolutePanel( draggable = TRUE, style ="red",fixed=TRUE,
# top = "100%",
# left = 1,
# right = 1,
# bottom = 1,
# width = 1,
# height = 1,
shiny::h1("Data"),
# shiny::numericInput("Number_of_modalities",
# "Number of modalities:",
# value = max(DF$m)# Default ----------
# ),
# shiny::numericInput("Number_of_readers",
# "Number of readers:",
# value = max(DF$q)# Default ----------
# ),
# shiny::numericInput("Number_of_confidence_levels",
# "Number of confidence levels:",
# value = max(DF$c)# Default ----------
# ),
# # shiny::actionButton("trigger_skeleton_of_data","Make a skeleton of data"),
#
shiny::sliderInput("Number_of_lesions",
"Number of lesions:",
min = 1, max = NL.max,
value = NL.initial# Default
),
shiny::sliderInput("Number_of_images",
"Number of images:",
min = 1, max = NI.max,
value = NI.initial#Default
),
shiny::h4(shiny::helpText( "Right-click on the table to delete/insert rows." )),
shiny::h4(shiny::helpText( "Double-click on a cell to edit")),
# shiny::h6(shiny::helpText(" h = hit = True Positive = TP.")),
# shiny::h6(shiny::helpText(" f = false alarms = False Positive = FP.")),
#
# shiny::h6(shiny::helpText(" m = modality ID")),
# shiny::h6(shiny::helpText(" q = reader ID")),
# shiny::h6(shiny::helpText(" c = confidence level")),
# TABLE data Handsontable-----
# rhandsontable::rHandsontableOutput("data_frame"),# Table of h and f
shiny::h4( shiny::strong( shiny::span( rhandsontable::rHandsontableOutput("data_frame") , style="color:#B30E0E; font-size:17pt;") ) ),# Table of h and f
shiny::h4(shiny::helpText( "To make a skeleton of dataset, use the followings " )),
# shiny::h4(shiny::helpText( "the author provides the following, " )),
# shiny::h4(shiny::helpText( "Tby which we can obtain a skeleton of dataset." )),
# TABLE of MQC -----
shiny::h4( shiny::strong( shiny::span( rhandsontable::rHandsontableOutput("data_frame_MQC") , style="color:#B30E0E; font-size:17pt;") ) ),# Table of h and f
shiny::h6(shiny::helpText("To edit more than 2 cells, a blank cell would help"))
# shiny::br()
), #absolutePanel
#MCMC param ------
shiny::absolutePanel( draggable = TRUE, style ="red",fixed=TRUE,
# top = "100%",
# left = 1,
# right = 1,
# bottom = 1,
# width = 1,
# height = 1,
shiny::h4("Parameter of the HMC"),
shiny::h4(shiny::helpText(" Larger is better.")),
#Number_of_MCMC_samples-----
shiny::sliderInput("Number_of_MCMC_samples",
"Number of MCMC samples:",
min = 11, max = 11111, value = 44),
shiny::h4(shiny::helpText(" Larger is better.")),
shiny::sliderInput("Number_of_MCMC_chains",
"Number of MCMC chains:",
min = 1, max = MCMC.chains.max, value = 1),
# MCMC seed -----
shiny::h4(shiny::helpText("The number is seed.")),
shiny::sliderInput("Number_of_MCMC_seed",
"seed to be passed to rstan::sampling():",
min = 1, max = 99999999, value = seed.initial.of.MCMC)
), #absolutePanel
shiny::sidebarLayout(
shiny::sidebarPanel(width = 5,
# wellPanel(
# shiny::h3("Trace plot"),
# radioButtons("stan_trace", "Trace plot", c("TRUE", "FALSE"))
# ),
# shiny::plotOutput("DrawCurves" ),
shiny::h1("Fitted curves"),
shiny::checkboxInput("DrawCFPCTP",
"FPF and TPF (Data)",
value = TRUE),
shiny::checkboxInput("DrawFROCcurve",
"FROC curve (Fitted model)",
value = TRUE),
shiny::checkboxInput("DrawAFROCcurve",
"AFROC curve (used for AUC) (Fitted model)",
value = FALSE),
# Curve Plot ----
shiny::plotOutput("DrawCurves", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
# Curve Plot Empirical----
# shiny::h6(shiny::helpText("Empirical curves")),
shiny::h1("Empirical Curves"),
shiny::plotOutput("DrawEmpiricalCurves", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
#
# shiny::em( "Modality ID"),
# shiny::h6(shiny::helpText("Specify the modality ID to be drawn")),
# shiny::checkboxInput("m1",
# "1st",
# value = TRUE),
#
#
#
#
#
#
#
#
#
# shiny::checkboxInput("m2",
# "2nd",
# value = FALSE),
#
#
# shiny::checkboxInput("m3",
# "3st",
# value = FALSE),
#
#
# shiny::checkboxInput("m4",
# "4nd",
# value = FALSE),
#
#
# shiny::checkboxInput("m5",
# "5st",
# value = FALSE),
#
#
# shiny::em( "Reader ID"),
# shiny::h6(shiny::helpText("Specify the Reader ID to be drawn")),
# shiny::checkboxInput("q1",
# "1st",
# value = TRUE),
#
# shiny::checkboxInput("q2",
# "2nd",
# value = FALSE),
#
#
# shiny::checkboxInput("q3",
# "3rd",
# value = FALSE),
#
#
#
# shiny::checkboxInput("q4",
# "4st",
# value = FALSE),
#
#
# shiny::checkboxInput("q5",
# "5st",
# value = FALSE),
#
#
#
shiny::wellPanel(
# divergent ----------------
shiny::h1("Check HMC diagnostics"),
shiny::h6("divergence"),
shiny::verbatimTextOutput("divergent_iterations_print"),
# treedepth ----------------
shiny::h6("treedepth"),
shiny::verbatimTextOutput("treedepth_print"),
shiny::h6("E-BFMI values "),
shiny::verbatimTextOutput("check_energy_print"),
shiny::h6("R hat"),
shiny::verbatimTextOutput("max_Rhat_print"),
shiny::br()
),
# save ----
shiny::h1("Save a fitted model object"),
shiny::actionButton("trigger_save_a_fitted_model_object","Save a fitted model object in Desktop"),
shiny::actionButton("trigger_save_a_fitted_model_object_working_directory","Save a fitted model object in Working directory"),
shiny::h6(shiny::helpText("* Put resulting file \"fit\" which has no extension in working directory of R and execute the code"), "load(\"fit\")", shiny::helpText(" from R console, then an R object named fit is available from R console. To change the S4 class to stanfit, use fitt <- methods::as(fit, \"stanfit\")")),
shiny::h4("Estimates"),
shiny::h6(shiny::helpText("Internet Environment is required for TeX script.")),
shiny::uiOutput("formula"),
shiny::wellPanel(
shiny::uiOutput("formula.TeX"),
shiny::uiOutput("formula.model"),
shiny::uiOutput("formula.AUC"),
shiny::uiOutput("formula.WAIC"),
shiny::uiOutput("formula.chisquare")
),#wellPanel
shiny::br()
# ,wellPanel(
# shiny::h3("Save"),
# actionButton("save", "Save table")
# )
# )
),#sidebarPanel
# shiny::column(6,
shiny::mainPanel(width = 7,
shiny::wellPanel(
shiny::h1("Statistics"),
shiny::verbatimTextOutput("AUC_ranking_print"),
# AUC Plot ----
shiny::plotOutput("AUC_CI", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
# trace_AUC ----
shiny::plotOutput("trace_AUC", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::h6(shiny::helpText(" Larger is better.")),
shiny::uiOutput("formula.AUC.without.TeX"),
shiny::h6(shiny::helpText("A number between 0 and 1, indicating observer performance.")),
shiny::h6(shiny::helpText("------------------------------------------------------------------------------------")),
shiny::h6(shiny::helpText(" Smaller is better.")),
shiny::uiOutput("formula.WAIC.without.TeX"),
shiny::h6(shiny::helpText("Evaluate whether our model is good.")),
shiny::h6(shiny::helpText("------------------------------------------------------------------------------------")),
shiny::h6(shiny::helpText(" Smaller is better.")),
shiny::uiOutput("formula.chisquare.without.TeX"),
shiny::uiOutput("EAP_of_chi_square"),
shiny::h6(shiny::helpText("A difference between data and expectations from estimates.")),
shiny::h6(shiny::helpText("------------------------------------------------------------------------------------")),
shiny::h6(shiny::helpText(" Larger is better.")),
shiny::em( shiny::uiOutput("ppp")),
shiny::h6(shiny::helpText(" Null hypothesis is that our model fit to the data well.")),
shiny::checkboxInput("ppp_calculate_trigger",
"Calculate P-value",
value = FALSE),
shiny::h6(shiny::helpText("It requires time."))
),
# shiny::h2(" FROC Curve and FPF,TPF"),
# shiny::h4(shiny::helpText("I love you :'-D If you love me, then employ me :)")),
# shiny::h4(shiny::helpText("In Hit rate plain, the canonical Gaussian is also drawn to show how the graph changes. ")),
# shiny::h4(shiny::helpText("In False rate plain, the signal Gaussian is also drawn to show how the graph changes. ")),
# shiny::h4(shiny::helpText("The thresholds are common between false alram and hit.")),
# shiny::h6(shiny::helpText("Internet Environment is required for TeX script.")),
shiny::plotOutput("bi_normal", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::plotOutput("false_rate", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::h6(shiny::helpText("The most right area corresponds the rate of the most high confidence.")),
shiny::checkboxInput("Colour_plot_of_rates",
"Colour",
value = TRUE),
shiny::checkboxInput("dark_theme",
"dark theme",
value = TRUE),
shiny::checkboxInput("mathmatical.symbols",
"What curve are drawn?",
value = TRUE),
shiny::sliderInput("density",
"density:",
min = 0, max = 100,
value = 23# Default
),
shiny::wellPanel(
# shiny::checkboxInput("FPF_per_Lesion",
# "FPF per Lesion",
# value = FALSE),
# per lesion or per image ----
shiny::selectInput("FPF_per_Lesion", "FPF",
c(
"False Positive Fraction per image (per trial)" = FALSE,
"False Positive Fraction per lesion (per signal, per nodule)" = TRUE
)
)
),#wellPanel
shiny::h2(" Posterior Estimates"),
shiny::h6(shiny::helpText(" mean = posterior mean")),
# shiny::h6(shiny::helpText(" se_mean = .... ")),
shiny::h6(shiny::helpText(" sd = Standard Deviation of posterior MCMC samples")),
shiny::h6(shiny::helpText(" 2.5% = Lower bound of Posterior Credible interval")),
shiny::h6(shiny::helpText(" 97.5% = Upper bound of Posterior Credible interval")),
shiny::h6(shiny::helpText(" Rhat = A criteria of Convergence for MCMC sampling, if it is more close to 1, then it is better. ")),
shiny::verbatimTextOutput("fit_print"),
shiny::h2(" Replicated FROC datasets to calculate a posterior predictive p value"),
shiny::checkboxInput("ppp_plot_trigger",
"Plot replicated datasets to calculate P-value",
value = FALSE),
shiny::h4(shiny::helpText("It requires time.")),
shiny::plotOutput("plot_ppp", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::checkboxInput("Colour",
"Colour",
value = FALSE),
shiny::checkboxInput("dark_theme_ppp",
"dark theme",
value = FALSE),
shiny::br()
)#mainPanel
)#sidebarLayout
),#tabPanel
shiny::tabPanel("Ref",
shiny::h2(" Reference:"),
shiny::h4(shiny::a( "See vignettes for more details", href="https://cran.r-project.org/package=BayesianFROC")),
shiny::h4(shiny::helpText(" Issei Tsunoda (2019): Pre-print; Bayesian Models for Free - Response Receiver Operating Characteristic Analysis.")),
shiny::h4(shiny::helpText(" Dev Chakraborty (1989) doi:10.1118/1.596358; Maximum likelihood analysis of free - response receiver operating characteristic (FROC) data.")),
shiny::h4(shiny::helpText(" Dev Chakraborty; Observer Performance Methods for Diagnostic Imaging, Foundations, Modeling, and Applications with R-Based Examples "))
),#tabPanel
shiny::tabPanel("stanmodel",
shiny::verbatimTextOutput("stanmodel_print"),
shiny::h4(shiny::helpText("This Stan code was written by Riyacobach Riyathoe and Ruikobach Sampota who are doggies, he was a champion in many sports such as ")),
shiny::h4(shiny::helpText("Best regards,")),
shiny::h4(shiny::a( "doggy", href="https://cran.r-project.org/package=BayesianFROC")),
# shiny::actionButton("Riya","RiyaSan"),
shiny::br()
),#tabPanel
shiny::tabPanel("Trace Plot",
shiny::actionButton("trigger_stan_trace_plot","Trace plot"),
# trace plot -----
shiny::plotOutput("plot_trace", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::h4(shiny::helpText("The author's older brother is biggy, his hiphop is very big hip! Piggy what are you doing, you still smoke in the water? Piggy is expert of chemistry, what are doing piggy, you still fat man? or big hip man?")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Piggy", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Histogram",
shiny::actionButton("trigger_stan_hist_plot","Histogram plot"),
# hist plot -----
shiny::plotOutput("plot_hist", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::sliderInput("hist_bins",
"Number of bins:",
min = 1, max = 777,
value = 30# Default
),
shiny::h4(shiny::helpText("The author's younger brother is rat, his teeth is outer and outer and outer. What are doing rat? you still work very hard position? He is also expert of chemistry, he did chemistry in his master degree. Ha, my brothers like chemisty. I cannot understand why chemistry is funny? I like Riemannian geometry. Are you happy now? You have a lot of money and a car, but you working eight days a week, is your own life? Oh, I got a call and he will marry, I cannot believe. So, he is happy, but me, I have aches. ha... ")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Rat", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Generic plot",
shiny::actionButton("trigger_stan_generic_plot","Trace plot"),
# generic plot -----
shiny::plotOutput("generic_plot", dblclick = shiny::dblclickOpts(id = "plot_dbl_click")),
shiny::h4(shiny::helpText("The author's younger and younger brother is nothing but his pokemon is tiny, pratin.")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Pratin", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Cat",
shiny::h4(shiny::helpText("To tell the truth, I am not interest to FROC analysis, what I want is only healthy life forever. I do not write any program for FROC analysis! I hate all such people! ")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Cat", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Fish",
shiny::h4(shiny::helpText(" Why FROC, to tell the truth, I am not sure, but only things what I want to say is I do not want to ride a rice for Sushi! ")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "Fish", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Carbus University",
shiny::h4(shiny::helpText(" I am a professor in both Carbus and Mosquitowbus univeristy
in which I study how to fight to mosquito in the
dark night. Mosquitos threaten me with his poooo00000000ooooooo0000000000ooooooooooo000000000000000ooooooon,
voice, so I try to catch them, but their stealth cannot
catch. I have to establish new theory how to fight them
to ensure our stable sleepping.
When I 17 years old, I establish the Carbus university and research how to fight Car ( which means mosquito in some language).
Yes, I am the fist president of Carbus university.
")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "The Author", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Ghostbus university",
shiny::h4(shiny::helpText(" I am a professor in the Ghostbus univeristy
in which I study how to fight to ghost. My studenta are the Ghostbusters.")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "The Author", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Acknowleage",
shiny::h4(shiny::helpText("This package is made with helps of many unknown people in stack over flows, and the author appreciate their kind helps. Also Stan developer gives me quick and appropriate advices in many times. Such many people helps me to develop this package. So, Michael Jackson says you are not alone!")),
shiny::h4(shiny::helpText("Best regards, ")),
shiny::h4(shiny::a( "The Author,", href="https://cran.r-project.org/package=BayesianFROC"))
),#tabPanel
shiny::tabPanel("Author",
shiny::h1(" Help!"),
shiny::h2(" The author: Issei Tsunoda <tsunoda.issei1111 _at_ gmail.com>"),
shiny::h3(" Employ me! :'-D, send me a mail <tsunoda.issei1111 _at_ gmail.com> I will go any country!"),
shiny::h5(" I am japanese and live in Japan, but if necessary,
I will go any country! Please help! I need somebody who employs me.
Help! Not just any body, HELP! I need someone! HEEEELP!
When I was younger so much, younger than today, I studied Riemannian Goematry.
But now and then, I feel that in mathematics I cannot obtain any result.
Help me if you can employ me in towns and I do apprecieate,..., I love the Beatles and Bach and Beethoven ( player is Wilhelm Kempf only), Aerothmith, John Lennon, Billy Joel, Ben E King,...etc.
"),
shiny::h5("Please employ me! :'-D Now, I have no job! I study differential geometry and
my most interest is complex differential geometry,
Kodaira-Spencer deformation theory, Gromov-Hausdorff topology, Ricci flow, mean curvature flow, Schubelt calculas. I want to go many nature place, not urban. In several month ago, my whole body has prurigo nodularis, so I hate sarfactant except bio-surfactant."),
shiny::h1("Multiple Chemical sensitivity (MCS)"),
shiny::h5("In a 2017, December, 28, My exposure to surfactant (I won't use, and never have used in my own life, it is required in my company) and other chemical materials in it, makes my body very bad condition that symptoms occur in multiple organ systems. In several hours later from the exposure, irritant darmatitis occured. During the first month from the exposure, my whole body has irritant stimulas, it is tiktik. And 14 month later from the exposure, my whole body has prurigo nodularis and other chronic conditions, in addition other disorders caused by the exposure are present in my body in now (18 months later from the exposure).
I am very sad since many people think it is psychogenic, but it is never such a thing, Complaints of MCS is very strong, should not dismissed as psychogenic. We shold not be kept waiting for development of the diagnosis. I suffer from chemical sensitivity.
All doctor who met me were lacking ability and didnot has any criteria of diagnosis for MCS.
"),
shiny::h5("Prurigos in My Mody"),
shiny::img(src="prurigo.jpg",height= "222", width="222"),
shiny::h1(" About my e-mail"),
shiny::h5(" I publish this package with my e-mail, then
spam mails comes.
When you sends me a mail, then please specify
some knowleage about mathematics ( Reimannian Geotmery or Kodaira Spencer theory) or FROC or Bayesian analysis.
Since my spam mails are all English, so I doubt English mails.
"),
shiny::h1(" About my package"),
shiny::h5(" I am not sure who is interest in my package,
Programming never finish forever,
so, ... I am tired."),
shiny::h1("Paper"),
shiny::h5(" My paper will publish soon.
I research some pure mathematical things about the Gromov Hausdorff topology
My heart is alwary with mathematics.
It is my destiny.
"),
shiny::h4(shiny::a( "R package BayesianFROC", href="https://cran.r-project.org/package=BayesianFROC"))
)#tabPanel
)#navbarPage
# )#shinyUI
# ))
#_____________________________------
server <- function(input, output) {
values <- shiny::reactiveValues()
# Data -----
shiny::observe({
if (!is.null(input$data_frame)) {
DF = rhandsontable::hot_to_r(input$data_frame)
} else {
if (is.null(values[["DF"]]))
DF <- DF
else
DF <- values[["DF"]]
}
values[["DF"]] <- DF
values[["dataList"]] <- list(NL=input$Number_of_lesions,
NI=input$Number_of_images,
h=DF$h,
f=DF$f,
c=DF$c,
m=DF$m,
q=DF$q,
M=max(DF$m),
Q=max(DF$q),
C=max(DF$c)
)
})
# Data_MQC -----
shiny::observe({
if (!is.null(input$data_frame_MQC)) {
DF_MQC = rhandsontable::hot_to_r(input$data_frame_MQC)
} else {
if (is.null(values[["DF_MQC"]]))
DF_MQC <- DF_MQC
else
DF_MQC <- values[["DF_MQC"]]
}
values[["DF_MQC"]] <- DF_MQC
})
# shiny::observeEvent(c( input$trigger_skeleton_of_data
# ), {
# counter$ssss <-c(counter$ssss, length( counter$ssss)+1)
# print(length( counter$ssss )==1)
# print( counter$ssss )
# })
#
# data ------
output$data_frame <- rhandsontable::renderRHandsontable({
DF <- values[["DF"]]
# if( length(counter$ssss) >3){
M <- values[["DF_MQC"]]$M
Q <- values[["DF_MQC"]]$Q
C <- values[["DF_MQC"]]$C
# h <- values[["dataList"]]$h
# f <- values[["dataList"]]$f
harray <- array_of_hit_and_false_alarms_from_vector( values[["dataList"]])$harray
farray <- array_of_hit_and_false_alarms_from_vector( values[["dataList"]])$farray
dimension <- dim(harray)
C_old <-dimension[1]
M_old <-dimension[2]
Q_old <-dimension[3]
harrayNew<-array(0,dim=c(C,M,Q));#Cumulative
farrayNew<-array(0,dim=c(C,M,Q));#Cumulative
for (cd in 1:C) {
for (md in 1:M) {
for (qd in 1:Q) {
if(cd <= C_old &&md <= M_old&&qd <= Q_old) harrayNew[cd,md,qd] <- harray[cd,md,qd]
if(cd > C_old ||md > M_old||qd > Q_old) harrayNew[cd,md,qd] <- NaN
if(cd <= C_old &&md <= M_old&&qd <= Q_old) farrayNew[cd,md,qd] <- farray[cd,md,qd]
if(cd > C_old ||md > M_old||qd > Q_old) farrayNew[cd,md,qd] <- NaN
}
}
}
h<-vector()
f<-vector()
for(md in 1:M) {
for(cd in 1:C) {
for(qd in 1 : Q){
f[cd+(md-1)*C*Q+(qd-1)*C]<-farrayNew[cd,md,qd]
h[cd+(md-1)*C*Q+(qd-1)*C]<-harrayNew[cd,md,qd]
}}}
mqc <- m_q_c_vector_from_M_Q_C(M,Q,C)
DF <- list(NL=input$Number_of_lesions,
NI=input$Number_of_images,
# h=rep(NaN, M*Q*C),
# f=rep(NaN, M*Q*C),
h=h,
f=f,
c=mqc$c,
m=mqc$m,
q=mqc$q,
M=M,
Q=Q,
C=C
)
if(M*Q*C <=30 && M*Q*C >5){ height <- M*Q*C*30 }
else if (M*Q*C <=30 && M*Q*C <=5 && M*Q*C >4){ height <- 120}
else if (M*Q*C <=30 && M*Q*C <=3){ height <- 1}
else {height <- 600}
DF <- extract_data_frame_from_dataList_MRMC(DF)
L <- length(DF)
comments_of_DF <- "Do not edit the cells in columns of modality, reader and rating by hands, instead, use the following GUIs to edit. The cells of hits and false alarms are editable cells by hands."
DF_comment <- data.frame( m= rep(comments_of_DF,( M*Q*C )),
q= rep(comments_of_DF,( M*Q*C )),
c= rep(comments_of_DF,( M*Q*C )),
h= rep(NA,( M*Q*C )),
# h= rep("test",( M*Q*C )),
f= rep(NA,( M*Q*C )) )
tableAAA<- rhandsontable::rhandsontable(DF,# width = 300,
height = height,
colHeaders = c( "Modality", "Reader","Rating","No. of Hits","No. of False Alarms"),
# enableComments=TRUE,#cause error , enableComments = !is.null(comments), ...) : formal argument "enableComments" matched by multiple actual arguments
comments =DF_comment,
stretchH = "all")
# tableAAA <- rhandsontable::hot_table(#decolartion for table
# tableAAA
# ,highlightCol = TRUE
# , highlightRow = TRUE#decolartion for table
# , stretchH = "all"
# # ,enableComments=TRUE#decolartion for table
# # ,rowHeaderWidth=88
# )
# for (columns in 1:3) {
# for (rows in 1:L) {
# tableAAA <- rhandsontable::hot_cell(tableAAA,
# row=rows,col=columns,
# readOnly = TRUE,
# comment = "Cannot edit by hand"
# )
#
# }
# }
tableBBB<- rhandsontable::hot_heatmap(tableAAA,
cols = c(1, 2, 3),
color_scale = c("#EBE4BC" , "#EDE7BE00" )
)# Table color cols <- colourpicker::colourPicker(5)
tableCCC<- rhandsontable::hot_heatmap(tableBBB,
cols = c(4,5),
color_scale = c("#FABBBB" , "#FABBBB1F" )
)# Table color cols <- colourpicker::colourPicker(5)
})
######### from here 2020 Aug
# Data MQC table ------
output$data_frame_MQC <- rhandsontable::renderRHandsontable({
DF_MQC <- values[["DF_MQC"]]
M <- DF_MQC$M
Q <- DF_MQC$Q
C <- DF_MQC$C
comments_of_DF <- "Editing this, the above table will change accordingly. Then edit the number of TPs FPs in the table to get own dataset.I Love you! \n Best regards, \n Doggy"
DF_comment <- data.frame( M=comments_of_DF,
Q=comments_of_DF,
C=comments_of_DF)
tableAAA<- rhandsontable::rhandsontable(DF_MQC,# width = 300,
# height = 20,
colHeaders = c("modality","reader","ratings"),
rowHeaders = NULL,
comments =DF_comment,
stretchH = "all")
tableCCC<- rhandsontable::hot_heatmap(tableAAA,
cols = c(1,2,3), color_scale = c("#FABBBB" , "#FABBBB")#"#FABBBB" , "#FABBBB1F" )
)# Table color cols <- colourpicker::colourPicker(5)
})
########### Up to here 2020 AUg
#Check -----
output$checkbox_GUI_Readers <- shiny::renderUI({
shiny::checkboxGroupInput("R_object_as_the_result_of_check_boxes_for_reader",
"Select Reader ID",
choices = seq(1:max(values[["dataList"]]$q)),
select =c(1,max(values[["dataList"]]$q)) # This specify the initial condition
)
})
output$txt_user_specifies_reader_IDs <- shiny::renderText({
icons <- paste(input$R_object_as_the_result_of_check_boxes_for_reader, collapse = ", ")
paste("Selected reader IDs:", icons)
})
output$checkbox_GUI_Modality <- shiny::renderUI({
shiny::checkboxGroupInput("R_object_as_the_result_of_check_boxes_for_modality",
"Select modality ID",
choices = seq(1:max(values[["dataList"]]$m)),
select =c(1,max(values[["dataList"]]$m)) # This specify the initial condition
)
})
output$txt_user_specifies_Modality_IDs <- shiny::renderText({
icons <- paste(input$R_object_as_the_result_of_check_boxes_for_modality, collapse = ", ")
paste("Selected modality IDs:", icons)
})
# This is use such as fit() instesad of fit
fit <- shiny::reactive({
# fit ----
fit <- BayesianFROC::fit_Bayesian_FROC(
# ite = 111,
print_CI_of_AUC = FALSE,
ite = input$Number_of_MCMC_samples,
see = input$Number_of_MCMC_seed,
cha = input$Number_of_MCMC_chains,
ModifiedPoisson = as.logical(input$FPF_per_Lesion),
summary = TRUE,
# Null.Hypothesis = FALSE,
dataList = values[["dataList"]],# input$selected_data ,
DrawCurve = F
# dig = 5,
# prior = as.integer(input$prior)
)
return(fit)
})
## Save
# shiny::observeEvent(input$save, {
# finalDF <- isolate(values[["DF"]])
# # saveRDS(finalDF, file=file.path(outdir, sprintf("%s.rds", outfilename)))
#
#
#
#
#
# })
# TeX data -----
output$formula <- shiny::renderUI({
# my_calculated_value <- extractAUC(fit(),dig = 4)[1]
C<-values[["dataList"]]$C
z<-apply( extract(fit())$z , 2, mean)
m <- mean( extract(fit())$m)
v <- mean( extract(fit())$v)
s<-"Posterior Mean of Model Parameters: "
for (cd in 1:C){
s<-paste0(s," $$z_",cd," = ",signif(z[cd],digits = 3),",$$")
}
s<-paste0(s," $$\\mu = ",signif(m,digits = 3),",$$")
s<-paste0(s," $$\\sigma = ",signif(v,digits = 3),",$$")
shiny::withMathJax(s)
})
output$formula.model <- shiny::renderUI({
# my_calculated_value <- extractAUC(fit(),dig = 4)[1]
C<-values[["dataList"]]$C
Q<-values[["dataList"]]$Q
M<-values[["dataList"]]$M
NL<-values[["dataList"]]$NL
NI<-values[["dataList"]]$NI
# h<-values[["dataList"]]$h
# f<-values[["dataList"]]$f
# c<-values[["dataList"]]$c
d <-metadata_to_fit_MRMC(values[["dataList"]])
h<-d$harray
f<-d$farray
# h_rev <- rev(h)
# f_rev <- rev(f)
z<-apply( extract(fit())$z , 2, mean)
# p<-apply( extract(fit())$p , 2, mean)
ppp<-apply( extract(fit())$ppp , c(2,3,4), mean)
dl<-apply( extract(fit())$dl , 2, mean)
m <- mean( extract(fit())$m)
v <- mean( extract(fit())$v)
c<-C:1
s<-"Posterior Mean of Model Parameters: "
for (cd in 1:C){
s<-paste0(s," $$z_",cd," = ",signif(z[cd],digits = 3),",$$")
}
s<-paste0(s," $$\\sigma = ",signif(v,digits = 3),",$$")
s<-paste0(s," $$\\mu = ",signif(m,digits = 3),",$$")
s<-paste0(s," * In the following, the subscripts means level of confidence, modality ID, reader ID, respectively. ")
for (qd in 1:Q){
for (md in 1:M){
for (cd in 1:C){
s<-paste0(s," $$H_{",cd,",",md,",",qd,"} \\sim \\text{Binomial}(",signif(ppp[cd,md,qd],digits = 3),",", NL,"), \\text{ the realization is } H_{",cd,",",md,",",qd,"} = ",h[C-cd+1,md,qd] ," .$$")
}}
}
for (cd in 1:C){
s<-paste0(s," $$F_{",cd,", m, r} \\sim \\text{Poisson}(",signif(dl[cd]*NI,digits = 3),"), \\text{for all } m = 1,...,",M," \\text{ and for all } r = 1,...,",Q,"$$")
}
for (qd in 1:Q){
for (md in 1:M){
for (cd in 1:C){
s<-paste0(s," $$F_{",cd,",",md,",",qd,"} \\sim \\text{Poisson}(",signif(dl[cd]*NI,digits = 3),"), \\text{ the realization is } F_{",cd,",",md,",",qd,"} = ",f[C-cd+1,md,qd] ," .$$")
}}
}
shiny::withMathJax(s)
})
# TeX ------
output$formula.AUC <- shiny::renderUI({
# C<-values[["dataList"]]$C
# NL<-values[["dataList"]]$NL
# NI<-values[["dataList"]]$NI
C<-values[["dataList"]]$C
Q<-values[["dataList"]]$Q
M<-values[["dataList"]]$M
# z<-apply( extract(fit())$z , 2, mean)
# p<-apply( extract(fit())$p , 2, mean)
# dl<-apply( extract(fit())$dl , 2, mean)
#
# m <- mean( extract(fit())$m)
# v <- mean( extract(fit())$v)
# a <- mean( extract(fit())$a)
# b <- mean( extract(fit())$b)
a<-apply( extract(fit())$aa , c(2,3), mean)
b<-apply( extract(fit())$bb , c(2,3), mean)
a <- signif(a,digits = 3)
b <- signif(b,digits = 3)
# bb <- signif(b^2,digits = 3)
AA<-apply( extract(fit())$AA , c(2,3), mean)
AA <- signif(AA,digits = 3)
s<-"* In the following, the Posterior Mean of AUC for each modality and each reader are calculated. "
# c<-C:1
for (qd in 1:Q){
for (md in 1:M){
s<-paste0(s," $$\\text{AUC}_{",md,",",qd,"}= \\Phi (\\frac{\\hat{a}_{",md,",",qd,"}}{\\sqrt{1+\\hat{b_{",md,",",qd,"}}^2}})=\\Phi (\\frac{",a[md,qd],"}{\\sqrt{1+",b[md,qd],"^2}}) = ",AA[md,qd],"$$ where estimates are posterior mean.")
}}
A<-apply( extract(fit())$A , 2, mean)
A <- signif(A,digits = 3)
s<- paste0(s,"Posterior Mean of AUC for each modality")
# c<-C:1
for (md in 1:M){
s<-paste0(s," $$\\text{AUC}_{",md,"}= \\frac{1}{",Q,"} \\Sigma_{r=1}^{",Q,"} AUC_{",md,",r} = ",A[md],"$$ where estimates are posterior mean.")
}
# AUC TeX -------
shiny::withMathJax(s)
})
# TeX ------
output$formula.WAIC <- shiny::renderUI({
WAIC <- fit()@WAIC
WAIC <- signif(WAIC,digits = 3)
s<-paste0(" $$\\text{WAIC} = ",WAIC,".$$")
shiny::withMathJax(s)
})
# TeX ------
output$formula.chisquare <- shiny::renderUI({
chisquare <- fit()@chisquare
chisquare <- signif(chisquare,digits = 3)
s<-paste0(" $$\\chi^2(\\text{data}|\\widehat{\\theta}) = ",chisquare,"$$ where estimates \\( \\widehat{ \\theta }\\) are at posterior mean of model parameters \\( \\theta \\).")
shiny::withMathJax(s)
})
# TeX ------
output$formula.TeX <- shiny::renderUI({
s<-paste0(" To show \\( \\TeX \\), internnet environment is required.")
shiny::withMathJax(s)
})
# output$formula.AUC.without.TeX <- shiny::renderUI({
# # C<-values[["dataList"]]$C
# # NL<-values[["dataList"]]$NL
# # NI<-values[["dataList"]]$NI
# #
# # z<-apply( extract(fit())$z , 2, mean)
# # p<-apply( extract(fit())$p , 2, mean)
# # dl<-apply( extract(fit())$dl , 2, mean)
# #
# # m <- mean( extract(fit())$m)
# # v <- mean( extract(fit())$v)
#
# a <- mean( extract(fit())$a)
# b <- mean( extract(fit())$b)
# a <- signif(a,digits = 3)
# b <- signif(b,digits = 3)
# # bb <- signif(b^2,digits = 3)
#
#
#
# A <- mean( extract(fit())$A)
# A <- signif(A,digits = 3)
#
# # c<-C:1
#
# s<-paste0("AUC = ",A)
# shiny::withMathJax(s)
# })
output$formula.WAIC.without.TeX <- shiny::renderUI({
WAIC <- fit()@WAIC
WAIC <- signif(WAIC,digits = 3)
s<-paste0(" WAIC = ",WAIC)
shiny::withMathJax(s)
})
output$formula.chisquare.without.TeX <- shiny::renderUI({
chisquare <- fit()@chisquare
chisquare <- signif(chisquare,digits = 3)
s<-paste0("chi square at posterior mean = ",chisquare)
shiny::withMathJax(s)
})
# ppp ------
output$ppp <- shiny::renderUI({
if (input$ppp_calculate_trigger) {
#
# ppp <- signif(ppp,digits = 3)
#
# if (ppp>=0.05) s<-paste0("Posterior Predictive P value = ",ppp)
# if (ppp< 0.05) s<-paste0("Posterior Predictive P value = ",ppp," *")
# if (ppp< 0.01) s<-paste0("Posterior Predictive P value = ",ppp," **")
#
}
if (!input$ppp_calculate_trigger) s<-paste0("Posterior Predictive P value is not calculated")
s<-paste0("Posterior Predictive P value is not calculated (Under construction)")
shiny::withMathJax(s)
})
output$EAP_of_chi_square <- shiny::renderUI({
# ppp <- ppp_srsc(fit())$p.value
# Chi.Square.for.each.MCMC.samples <- chi_square_goodness_of_fit(fit() )
Chi.Square.for.each.MCMC.samples <- Chi_square_goodness_of_fit_in_case_of_MRMC_Posterior_Mean(fit() )
m<- mean(Chi.Square.for.each.MCMC.samples$chi.square)
m <- signif(m,digits = 3)
s<-paste0("Posterior mean of chi square = ",m)
shiny::withMathJax(s)
})
# output$formula <- renderUI({
# my_calculated_value <- extractAUC(fit(),dig = 4)[1]
# withMathJax(paste0("Posterior mean of AUC (area under the AFROC curve): $$\\widehat{AUC} =", my_calculated_value,"$$"))
# })
output$fit_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fitt <-methods::as(fit(), "stanfit")
# print( fitt, digits = 4)
a<- summary(fitt,probs=c(0.025,0.975))$summary
print(a)
# }# if
#
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# counter -----
counter <- shiny::reactiveValues()
shiny::observeEvent(c(input$trigger_stan_trace_plot
# ,input$hot
), {
counter$s <-c(counter$s, length( counter$s)+1)
})
shiny::observeEvent(c( input$trigger_stan_hist_plot
# input$hist_bins
), {
counter$ss <-c(counter$ss, length( counter$ss)+1)
})
shiny::observeEvent(c( input$trigger_stan_generic_plot
# input$hist_bins
), {
counter$sss <-c(counter$sss, length( counter$sss)+1)
})
# shiny::observeEvent(c( input$trigger_skeleton_of_data
# # input$hist_bins
# ), {
# counter$ssss <-c(counter$ssss, length( counter$ssss)+1)
# })
# trace--------
output$plot_trace <- shiny::renderPlot({
if (input$trigger_stan_trace_plot) {
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
print(paste( "s = ", length(counter$s) ) )
if(floor(length(counter$s) /2)==length(counter$s) /2){
if ( check_hit_is_less_than_NL(values[["dataList"]]) ) {
fit <- fit()
message("Now, we plot trace of MCMC ....")
return(rstan::stan_trace(fit,pars = c("lp__")))
}
if ( !check_hit_is_less_than_NL(values[["dataList"]]) ) {
error_message(h,NL)
}#if
}
}else if (!input$trigger_stan_trace_plot||!floor(length(counter$s) /2)==length(counter$s) /2) {
message("Now, we omit trace of MCMC ....")
return( plot(0,0,type="n", axes = TRUE,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="",ylab="",main="")
)
}
})#shiny::renderPlot 2020 march 12
# hist ------
output$plot_hist <- shiny::renderPlot({
if (input$trigger_stan_hist_plot) {
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
print(paste( "ss = ", length(counter$ss) ) )
if(floor(length(counter$ss) /2)==length(counter$ss) /2){
if ( check_hit_is_less_than_NL(values[["dataList"]]) ) {
fit <- fit()
message("Now, we plot trace of MCMC ....")
return(rstan::stan_hist (fit,pars = c("A"),bins=input$hist_bins))
}
if (! check_hit_is_less_than_NL(values[["dataList"]]) ) {
# error_message(h,NL)
plot(0,0,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="Please fix inconsistent data",ylab="",main="Error: Inconsistent Data \n In baseball game, \n batter's number of hits can not be greater than his number of at-bats")
graphics::text(0.5,0.8,c("*Now, Sum of the number of hits is greater than that of lesions; \n\n", expression(paste(h1+h2+h3+... , " > Number of Lesions")) ),col="white",cex = 1.4 )
}#if
}
}else if (!input$trigger_stan_trace_plot||!floor(length(counter$ss) /2)==length(counter$ss) /2) {
message("Now, we omit trace of MCMC ....")
return( plot(0,0,type="n", axes = TRUE,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="",ylab="",main="")
)
}
})#shiny::renderPlot
output$stanmodel_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
# print(prior_print_srsc(input$prior))
print(fit()@stanmodel)
# }# if
#
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
output$prior_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
# print(prior_print_srsc(input$prior))
prior_print_srsc(input$prior)
# }# if
#
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# max_Rhat_print -----
output$max_Rhat_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fit <-fit()
fitt <- methods::as(fit,"stanfit")
max.rhat <- round( max(summary(fitt)$summary[,"Rhat"]) ,digits = 5)
print(paste("max R-hat = ", max.rhat))
# }# if
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# divergent_iterations_print -----
output$divergent_iterations_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fit <-fit()
fitt <- methods::as(fit,"stanfit")
divergent <- rstan::get_divergent_iterations(fitt)
n <- sum(divergent)
N <- length(divergent)
if(!n==0) print(paste( n, " of ", N, "iterations ended with a divergence.",n,"/",N,"=", round( n/N ,digits = 2)))
if(n==0) print(paste( ":) OK"))
# }# if
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# treedepth_print -----
output$treedepth_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fit <-fit()
fitt <- methods::as(fit,"stanfit")
max_depth <- get_treedepth_threshold(fitt)
treedepths <- rstan::get_max_treedepth_iterations(fitt)
n <- sum(treedepths)
N <- length(treedepths)
if(!n==0) print(paste( n, " of ", N, "iterations saturated the maximum tree depth of.", max_depth,"."))
if(n==0) print(paste( ":) OK"))
# print("Not done ........... because get_treedepth_threshold is not an exported object from 'namespace:rstan' and hence the author omitted the evaluation from here. ")
# }# if
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# check_energy_print -----
output$check_energy_print <- shiny::renderPrint({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
fit <-fit()
fitt <- methods::as(fit,"stanfit")
EBFMIs <- get_bfmi(fitt)
bad_chains <- which(EBFMIs < 0.2)
if (!length(bad_chains)) {
# print("E-BFMI indicated no pathological behavior.")
print(paste( ":) OK"))
}
else {
print(paste("E-BFMI indicated possible pathological behavior:\n"
," Chain %s: E-BFMI = %.3f\n", bad_chains,
EBFMIs[bad_chains], "E-BFMI below 0.2 indicates you may need to reparameterize your model."))
}
# }# if
#
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# save a fitted model in Desktop ----
shiny::observeEvent(input$trigger_save_a_fitted_model_object,{
fit <- fit()
save( fit,file =paste0(file.path(Sys.getenv("USERPROFILE"),"Desktop"),"\\fit") )
# save( fit,file ="fit" )
tcltk::tkmessageBox(message=paste("\n* A file (name: \"fit\") is created in Desktop. In the file, an fitted model R object (name \"fit\") is contained, which is an object of an S4 class (stanfitExtended)\n\n\n 1) Put the resulting file \"fit\" in the working directory,\n 2) Run an R script \n load(\"fit\") \n\n then the R object named \"fit\" is available on your R console. "))
} )
# save a fitted model in Working directory ----
shiny::observeEvent(input$trigger_save_a_fitted_model_object_working_directory,{
fit <- fit()
save( fit,file ="fit" )
tcltk::tkmessageBox(message=paste("\n* A file (name: \"fit\") is created in the current working directory. In the file, an fitted model R object (name \"fit\") is contained, which is an object of an S4 class (stanfitExtended)\n\n\n 1) Put the resulting file \"fit\" in the working directory,\n 2) Run an R script \n load(\"fit\") \n\n then the R object named \"fit\" is available on your R console. "))
} )
# AUC_ranking_print -----
output$AUC_ranking_print <- shiny::renderPrint({
# h<-values[["dataList"]]$h
# NL<-values[["dataList"]]$NL
# if (sum(h)<=NL) {
# fitt <-methods::as(fit(), "stanfit")
# print( fitt, digits = 4)
# a<- summary(fitt,probs=c(0.025,0.975))$summary
# print(sortAUC(fit()))
sortAUC(fit())
# }# if
# if (sum(h)>NL) { print("Data format error, number of hits never greater than the number of signals. In Radiological context, signal is lesion.") }
})# shiny::renderPrint
# Plor curve -----
output$DrawCurves <- shiny::renderPlot({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
M<-values[["dataList"]]$M
Q<-values[["dataList"]]$Q
# if (sum(h)<=NL) {
# grDevices::dev.off()
# grDevices::dev.set()
if (input$dark_theme==TRUE) { # This cords clear plot environment in shiny GUI board.
dark_theme();
plot(0,0, # Dumy plot to clean plot environment, this is required only Shiny board, I do not know the reason.
type="n",
axes=FALSE,
xlim=c(0,1),
ylim =c(0,1),
xaxt="n",
yaxt="n",
xlab="",
ylab="")
}
if(check_hit_is_less_than_NL(values[["dataList"]] ) ){
DrawCurves(fit(),
# Colour = FALSE,
Colour = input$dark_theme,
readerID = as.integer(input$R_object_as_the_result_of_check_boxes_for_reader),
modalityID = as.integer(input$R_object_as_the_result_of_check_boxes_for_modality),
new.imaging.device = FALSE,
DrawCFPCTP = input$DrawCFPCTP,
DrawFROCcurve = input$DrawFROCcurve,
DrawAFROCcurve = input$DrawAFROCcurve)
# }
}
if(!check_hit_is_less_than_NL(values[["dataList"]] ) ){
# if (sum(h)> NL) {
#
# h.string <- as.character(h)
# for (cd in 1:length(h.string)) {
# if (cd==1){ s<-""; s <- paste(h.string[cd],sep = "+")}
# if ( !cd==1)s <- paste(s,h.string[cd],sep = "+")
#
# }#for
# sum.of.h <- s
# sum.of.h <- paste(sum.of.h,"=",as.character( sum(h) ) )
#
plot(0,0,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="Please fix inconsistent data",ylab="",main="Error: Inconsistent Data \n In baseball game, \n batter's number of hits can not be greater than his number of at-bats")
#
graphics::text(0.5,0.8,c("*Now, Sum of the number of hits is greater than that of lesions; \n\n", expression(paste(h1+h2+h3+... , " > Number of Lesions")) ),col="white",cex = 1.4 )
# graphics::text(0.5,0.65,paste("In the current inputed data, it is the following: " ),col="black",cex = 1.5 )
# graphics::text(0.5,0.5,paste( sum.of.h , " > ",NL,sep = ""),col="red",cex = 2)
#
# graphics::text(0.5,0.3,c("* Please fix so that the following inequality holds \n", expression(paste(h1+h2+h3+... , " < Number of lesions"))),col="blue",cex = 1.5 )
# graphics::text(0.5,0.1,c("* Shoud decrease the number of hits or \n Shoud increase the number of lesions"),col="blue",cex = 1.5 )
#
#
#
}
# }#if
})#shiny::renderPlot
# plot curve Empirical-----
# Plor curve -----
output$DrawEmpiricalCurves <- shiny::renderPlot({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
M<-values[["dataList"]]$M
Q<-values[["dataList"]]$Q
# if (sum(h)<=NL) {
# grDevices::dev.off()
# grDevices::dev.set()
if (input$dark_theme==TRUE) { # This cords clear plot environment in shiny GUI board.
dark_theme();
plot(0,0, # Dumy plot to clean plot environment, this is required only Shiny board, I do not know the reason.
type="n",
axes=FALSE,
xlim=c(0,1),
ylim =c(0,1),
xaxt="n",
yaxt="n",
xlab="",
ylab="")
}
if(check_hit_is_less_than_NL(values[["dataList"]] ) ){
plot_empirical_FROC_curves(fit()@dataList,
ModifiedPoisson = as.logical(input$FPF_per_Lesion),
readerID = as.integer(input$R_object_as_the_result_of_check_boxes_for_reader),
modalityID = as.integer(input$R_object_as_the_result_of_check_boxes_for_modality),
)
# }
}
if(!check_hit_is_less_than_NL(values[["dataList"]] ) ){
# if (sum(h)> NL) {
#
# h.string <- as.character(h)
# for (cd in 1:length(h.string)) {
# if (cd==1){ s<-""; s <- paste(h.string[cd],sep = "+")}
# if ( !cd==1)s <- paste(s,h.string[cd],sep = "+")
#
# }#for
# sum.of.h <- s
# sum.of.h <- paste(sum.of.h,"=",as.character( sum(h) ) )
#
plot(0,0,xlim=c(0,1),ylim =c(0,1),xaxt="n", yaxt="n",xlab="Please fix inconsistent data",ylab="",main="Error: Inconsistent Data \n In baseball game, \n batter's number of hits can not be greater than his number of at-bats")
#
graphics::text(0.5,0.8,c("*Now, Sum of the number of hits is greater than that of lesions; \n\n", expression(paste(h1+h2+h3+... , " > Number of Lesions")) ),col="white",cex = 1.4 )
# graphics::text(0.5,0.65,paste("In the current inputed data, it is the following: " ),col="black",cex = 1.5 )
# graphics::text(0.5,0.5,paste( sum.of.h , " > ",NL,sep = ""),col="red",cex = 2)
#
# graphics::text(0.5,0.3,c("* Please fix so that the following inequality holds \n", expression(paste(h1+h2+h3+... , " < Number of lesions"))),col="blue",cex = 1.5 )
# graphics::text(0.5,0.1,c("* Shoud decrease the number of hits or \n Shoud increase the number of lesions"),col="blue",cex = 1.5 )
#
#
#
}
# }#if
})#shiny::renderPlot
# AUC plot -----
output$AUC_CI <- shiny::renderPlot({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
M<-values[["dataList"]]$M
Q<-values[["dataList"]]$Q
# if (sum(h)<=NL) {
# grDevices::dev.off()
# grDevices::dev.set()
if (input$dark_theme==TRUE) { # This cords clear plot environment in shiny GUI board.
dark_theme();
plot(0,0, # Dumy plot to clean plot environment, this is required only Shiny board, I do not know the reason.
type="n",
axes=FALSE,
xlim=c(0,1),
ylim =c(0,1),
xaxt="n",
yaxt="n",
xlab="",
ylab="")
}
nnname <- vector()
for (md in 1:M) {
nnname[md] <-paste("A[",md,"]",sep = "")
}
print( rstan::plot(methods::as(fit(), "stanfit"),par=nnname))
# extractAUC( fit() ,print_CI_of_AUC = TRUE, new.imaging.device = FALSE)
})#shiny::renderPlot
# trace plot for AUC trace_AUC -----
output$trace_AUC <- shiny::renderPlot({
h<-values[["dataList"]]$h
NL<-values[["dataList"]]$NL
M<-values[["dataList"]]$M
Q<-values[["dataList"]]$Q
# if (sum(h)<=NL) {
# grDevices::dev.off()
# grDevices::dev.set()
if (input$dark_theme==TRUE) { # This cords clear plot environment in shiny GUI board.
dark_theme();
plot(0,0, # Dumy plot to clean plot environment, this is required only Shiny board, I do not know the reason.
type="n",
axes=FALSE,
xlim=c(0,1),
ylim =c(0,1),
xaxt="n",
yaxt="n",
xlab="",
ylab="")
}
nnname <- vector()
for (md in 1:M) {
nnname[md] <-paste("A[",md,"]",sep = "")
}
print( rstan::stan_trace(methods::as(fit(), "stanfit"),par=nnname))
# extractAUC( fit() ,print_CI_of_AUC = TRUE, new.imaging.device = FALSE)
})#shiny::renderPlot
}
## run app
shiny::runApp(list(ui=ui, server=server))
return(invisible())
}
Try the BayesianFROC package in your browser
Any scripts or data that you put into this service are public.
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.