inst/shiny-apps/detzrcr_app/app.R

ui <- shiny::fluidPage(shiny::navbarPage("detzrcr",
                        shiny::tabPanel('Data Input', shiny::sidebarLayout(
                          shiny::sidebarPanel(
                            shiny::conditionalPanel(
                              condition = 'input.example_data == false',
                              shiny::fileInput('file1', 'Select CSV File',
                                               accept=c('text/csv',
                                                        'text/comma-separated-values,text/plain',
                                                        '.csv'), multiple = TRUE),
                              shiny::tags$hr(),
                              shiny::radioButtons('sep', 'Separator',
                                                  c(Comma=',',
                                                    Semicolon=';',
                                                    Tab='\t'),
                                                  ','),
                              shiny::radioButtons('quote', 'Quote',
                                                  c(None='',
                                                    'Double Quote'='"',
                                                    'Single Quote'="'"),
                                                  '"'),
                              shiny::tags$hr()),
                            shiny::checkboxInput('disc',
                                                 label = 'Remove discordant data',
                                                 value = FALSE),
                            shiny::uiOutput('show_disc_limit'),
                            shiny::tags$hr(),
                            shiny::checkboxInput('example_data',
                                                 'Display example data',
                                                 value=FALSE),
                            shiny::tags$hr(),
                            shiny::checkboxInput('sample_freq',
                                                 'Show sample frequencies',
                                                 value=FALSE)
                          ),
                          shiny::mainPanel(
                            DT::dataTableOutput('head'),
                            shiny::textOutput('nas'),
                            shiny::tableOutput('numbers')
                          )
                        )),

                        # Start of density distribution tab
                        shiny::tabPanel('Density Distribution ', shiny::sidebarLayout(
                          shiny::sidebarPanel(
                            shiny::radioButtons('type', 'Density distribution type',
                                                c(KDE='kde',
                                                  PDP='pdd')),
                            shiny::checkboxInput('hist', label = 'Histogram', value = TRUE),
                            shiny::checkboxInput('fixed_y', label= 'Fixed y-axis', value = FALSE),
                            shiny::selectInput('dens_type', 'Plot type',
                                               c('All samples in one'='dens_facet',
                                                 'Individual samples'='dens_ind',
                                                 'Combine samples'='dens_combine')),
                            shiny::uiOutput('dens_switch'),
                            shiny::numericInput('binwidth', 'Binwidth', 50),
                            shiny::numericInput('bw', "Bandwidth", 30),
                            shiny::numericInput('xstart', "X-axis start (Ma)",
                                                value=200,min=0,max=4600,step=100),
                            shiny::numericInput('xstop', "X-axis start (Ma)",
                                                value=4000,min=0,max=4600,step=100),
                            shiny::numericInput('xstep', 'X step', 200),
                            shiny::numericInput('densWidth', 'Image Width (cm)', 15),
                            shiny::numericInput('densHeight', 'Image Height (cm)', 15),
                            shiny::downloadButton('downloadDensplot', 'Save Image')),
                          shiny::mainPanel(
                            shiny::plotOutput('dens_plot')
                          )
                        )),

                        # Start of ECDF tab
                        shiny::tabPanel('ECDF', shiny::sidebarLayout(
                          shiny::sidebarPanel(
                            shiny::radioButtons('ecdf_input_type', 'Type',
                                                c('Age'='age',
                                                  'Model age'='t_dm2')),
                            shiny::selectInput('ecdf_type', 'Plot type',
                                               c('All samples in one'='same_plot',
                                                 'Individual samples'='ind_plot',
                                                 'Combine samples'='ecdf_combine_plot')),
                            shiny::uiOutput("ecdf_switch"),
                            shiny::checkboxInput('ecdf_conf', label='Confidence bands', value=FALSE),
                            shiny::numericInput('ecdf_xstart', 'X-axis start (Ma)',
                                                value=200,min=0,max=4600,step=100),
                            shiny::numericInput('ecdf_xstop', 'X-axis stop (Ma)',
                                                value=4000,min=0,max=4600,step=100),
                            shiny::numericInput('ecdf_xstep', 'X-axis step (Ma)', 200),
                            shiny::checkboxInput("ecdf_legend", label = "Show legend", value = TRUE),
                            shiny::numericInput('ecdf_width', 'Image Width (cm)', 15),
                            shiny::numericInput('ecdf_height', 'Image Height (cm)', 15),
                            shiny::downloadButton('download_ecdf_plot', 'Save Image')
                          ),
                          shiny::mainPanel(
                            shiny::plotOutput(('ecdf_plot'))
                          )
                        )),

                        # Start of UQ vs. tLQ tab
                        shiny::tabPanel('UQ vs. LQ', shiny::sidebarLayout(
                          shiny::sidebarPanel(
                            shiny::radioButtons('uqlq_type', 'UQ vs. LQ type',
                                                c('Age'='uqlq_age',
                                                  'Model age'='uqlq_tdm')),
                            shiny::uiOutput('uqlq_samples'),
                            shiny::numericInput('uqlq_xstep', 'X step', 500),
                            shiny::numericInput('uqlq_xstart', 'X-axis start (Ma)',
                                                value=200,min=0,max=4600,step=100),
                            shiny::numericInput('uqlq_xstop', 'X-axis stop (Ma)',
                                                value=4000,min=0,max=4600,step=100),
                            shiny::numericInput('uqlq_ystart', 'Y-axis start (Ma)',
                                                value=200,min=0,max=4600,step=100),
                            shiny::numericInput('uqlq_ystop', 'Y-axis stop (Ma)',
                                                value=4000,min=0,max=4600,step=100),
                            shiny::checkboxInput('uqlq_conf',
                                                 label='Confidence limits',
                                                 value=FALSE),
                            shiny::checkboxInput('mixing_model',
                                                 label='Add mixing model',
                                                 value=FALSE),
                            shiny::conditionalPanel(
                              condition="input.mixing_model == true",
                              shiny::numericInput('mu1', 'First mean', value=500),
                              shiny::numericInput('sig1', 'First standard deviation',
                                                  value=50),
                              shiny::numericInput('mu2', 'Second mean', value=1000),
                              shiny::numericInput('sig2', 'Second standard deviation',
                                                  value=100)),
                            shiny::tags$hr(),
                            shiny::checkboxInput("uqlq_legend", label = "Show legend", value = TRUE),
                            shiny::numericInput('uqlq_width', 'Image Width (cm)', 15),
                            shiny::numericInput('uqlq_height', 'Image Height (cm)', 15),
                            shiny::downloadButton('download_uqlq_plot', 'Save Image'),
                            shiny::tags$hr()
                          ),
                          shiny::mainPanel(
                            shiny::plotOutput(('uqlq'))
                          )
                        )),

                        # Start of Hf tab
                        shiny::tabPanel('Lu-Hf', shiny::sidebarLayout(
                          shiny::sidebarPanel(
                            shiny::radioButtons('hf_type', 'Type',
                                                c('Epsilon Hf'='ehf_plot',
                                                  'Hf/Hf'='hfhf_plot')),
                            shiny::uiOutput('hf_samples'),
                            shiny::numericInput('hf_xstart', 'X-axis start (Ma)',
                                                value=200,min=0,max=4600,step=100),
                            shiny::numericInput('hf_xstop', 'X-axis stop (Ma)',
                                                value=4000,min=0,max=4600,step=100),
                            shiny::numericInput('hf_xstep', 'X step', 200),
                            shiny::uiOutput("hf_switch"),
                            shiny::tags$hr(),
                            shiny::checkboxInput('error_bars',
                                                 label = 'Add error bars',
                                                 value = FALSE),
                            shiny::conditionalPanel(
                              condition = 'input.error_bars == true',
                              shiny::checkboxInput('x_error_bars',
                                                   label = 'X-direction error bars',
                                                   value = TRUE),
                              shiny::checkboxInput('y_error_bars',
                                                   label = 'Y-direction error bars',
                                                   value = TRUE)
                            ),
                            shiny::tags$hr(),
                            shiny::checkboxInput('add_contours',
                                                 label = 'Add contours',
                                                 value = FALSE),
                            shiny::uiOutput('hf_bandwidths'),
                            shiny::uiOutput('contour_switch'),
                            shiny::tags$hr(),
                            shiny::checkboxInput("hf_legend", label = "Show legend", value = TRUE),
                            shiny::numericInput('hf_width', 'Image Width (cm)', 15),
                            shiny::numericInput('hf_height', 'Image Height (cm)', 15),
                            shiny::downloadButton('download_hf_plot', 'Save Image'),
                            shiny::tags$hr(),
                            shiny::downloadButton('download_hf_table', 'Save Lu-Hf Table')
                          ),
                          shiny::mainPanel(
                            shiny::plotOutput(('hf'))
                          )
                        )),

                        # Start of likeness tab
                        shiny::tabPanel('Likeness', shiny::sidebarLayout(
                          shiny::sidebarPanel(
                            shiny::radioButtons('likeness_type', 'Type',
                                                c('1d (age)'='1d',
                                                  '2d (age and eHf)'='2d',
                                                  'Combine'='combine')),
                            shiny::uiOutput('likeness_samples'),
                            shiny::numericInput('likeness_age_bw', 'Age bandwidth', 30),
                            shiny::uiOutput('likeness_bw'),
                            shiny::downloadButton('download_likeness_table', 'Save Table')
                          ),
                          shiny::mainPanel(
                            shiny::tableOutput('likeness')
                          )
                        )),

                        # Start of O-parameter age tab
                        shiny::tabPanel('1-O', shiny::sidebarLayout(
                          shiny::sidebarPanel(
                            shiny::radioButtons('o_type', 'Type',
                                                c('Age'='age',
                                                  'Model age'='tdm',
                                                  'Combine' ='combine')),
                            shiny::uiOutput('o_samples'),
                            shiny::downloadButton('download_o_table', 'Save Table'),
                            shiny::tags$hr(),
                            shiny::checkboxInput("o_fig", label = "Graphical", value = FALSE),
                            shiny::conditionalPanel(
                              condition = 'input.o_fig == true',
                              shiny::numericInput('o_width', 'Image Width (cm)', 15),
                              shiny::numericInput('o_height', 'Image Height (cm)', 15),
                              shiny::downloadButton('download_o_plot', 'Save Image')
                            )
                          ),
                          shiny::mainPanel(
                            shiny::uiOutput('o_switch')
                          )
                        )),

                        # Start of Reimink tab
                        shiny::tabPanel('Reimink', shiny::sidebarLayout(
                          shiny::sidebarPanel(
                            shiny::uiOutput('reimink_samples'),
                            shiny::numericInput('reimink_step', 'Chord step (My)', 100),
                            shiny::tags$hr(),
                            shiny::numericInput('reimink_width', 'Image Width (cm)', 15),
                            shiny::numericInput('reimink_height', 'Image Height (cm)', 15),
                            shiny::downloadButton('download_reimink_plot', 'Save Image')
                          ),
                          shiny::mainPanel(
                            shiny::plotOutput('reimink_plot'),
                            shiny::tags$hr(),
                            shiny::tags$p('Lower: '),
                            shiny::verbatimTextOutput('reimink_maxima_lower'),
                            shiny::tags$p('Upper: '),
                            shiny::verbatimTextOutput('reimink_maxima_upper'),
                            shiny::tags$hr(),
                            shiny::downloadButton('download_reimink_table', 'Save likelihood data')
                          )
                        )),
                        shiny::navbarMenu('More',
                        # Start of Constants tab
                        shiny::tabPanel('Constants', shiny::fluidPage(
                          shiny::fluidRow(
                            shiny::column(4,
                                          shiny::numericInput('lambda_lu',
                                                              '176Lu decay constant',
                                                              lambda_lu),
                                          shiny::tags$hr(),
                                          shiny::numericInput('luhf_chur',
                                                              '176Lu/177Hf CHUR',
                                                              luhf_chur),
                                          shiny::numericInput('hfhf_chur',
                                                              '176Hf/177Hf CHUR',
                                                              hfhf_chur),
                                          shiny::tags$hr(),
                                          shiny::numericInput('luhf_dm',
                                                              '176Lu/177Hf DM',
                                                              luhf_dm),
                                          shiny::numericInput('hfhf_dm',
                                                              '176hf/177Hf DM',
                                                              hfhf_dm),
                                          shiny::numericInput('luhf_zrc',
                                                              '176Lu/177Hf',
                                                              luhf_zrc)
                            )
                          )
                        )),
                        # Start of Plot options tab
                        shiny::tabPanel('Plot options', shiny::fluidPage(
                          shiny::fluidRow(
                            shiny::column(4,
                                          shiny::selectInput('font_name', 'Font',
                                                             if (.Platform$OS.type == 'windows')
                                                               c('Helvetica' = 'sans', 'Courier' = 'mono',
                                                                 'Times'= 'serif')
                                                             else
                                                               c('Helvetica', 'Courier', 'Times')),
                                          shiny::tags$hr(),
                                          shiny::sliderInput('title_size', 'Axes title size (pts)',
                                                             min = 5, max = 20, value = 10),
                                          shiny::sliderInput('label_size', 'Axes label size (pts)',
                                                             min = 5, max = 20, value = 7),
                                          shiny::sliderInput('legend_size', 'Legend text size (pts)',
                                                             min = 5, max = 20, value = 10),
                                          shiny::sliderInput('strip_size', 'Panel text size (pts)',
                                                             min = 5, max = 20, value = 7),
                                          shiny::tags$hr()
                            )
                          )
                        )),
                        shiny::tabPanel('About', shiny::fluidPage(
                          shiny::fluidRow(
                            shiny::column(12, align='center',
                                          shiny::h3(paste('detzrcr', as.character(packageVersion('detzrcr')))),
                                          shiny::tags$br(),
                                          shiny::tags$div(class='header', checked=NA,
                                                          shiny::tags$a(href='https://cran.r-project.org/package=detzrcr',
                                                                        'https://cran.r-project.org/package=detzrcr'),
                                                          shiny::tags$br(),
                                                          shiny::tags$a(href='https://github.com/magnuskristoffersen/detzrcr',
                                                                        'https://github.com/magnuskristoffersen/detzrcr'),
                                                          shiny::tags$br(),
                                                          shiny::tags$a(href='https://cran.r-project.org/web/packages/detzrcr/vignettes/detzrcr-vignette.html',
                                                                        'https://cran.r-project.org/web/packages/detzrcr/vignettes/detzrcr-vignette.html')))
                          ))
                        ))
))

server <- shiny::shinyServer(function(input, output) {
  # Reactives
  csv_data <- shiny::reactive({
    numbers <- NULL
    n_conc <- NULL
    n_hf <- NULL
    if (input$example_data == FALSE) {
      inFile <- input$file1
      if (is.null(inFile)) {
        return(NULL)
      }
      n <- dim(inFile)[1]
      if (n == 1) {
        dat <- utils::read.csv(inFile$datapath, header=TRUE, sep=input$sep,
                               quote=input$quote)
      }
      if (n > 1) {
        dat <- utils::read.csv(inFile[[1, 'datapath']], header=TRUE,
                               sep=input$sep, quote=input$quote)
        for (i in seq(2, n)) {
          csv <- utils::read.csv(inFile[[i, 'datapath']], header=TRUE,
                          sep=input$sep, quote=input$quote)
          dat <- merge(dat, csv, all = TRUE)

        }
      }
    } else {
      dat <- utils::read.csv(system.file("extdata", "Natal_group.csv",
                                           package="detzrcr"))
    }
    names(dat) <- tolower(names(dat))
    if ('sample' %in% names(dat)) {
      dat$sample <- as.factor(dat$sample)
    }
    n_analyses <- aggregate(dat$sample, by = dat['sample'], length)
    if (input$disc) {
      nas <- NULL
      if ((is.character(dat$disc)) | (is.factor(dat$disc))) {
        dat$disc <- suppressWarnings(as.numeric(as.character(dat$disc)))
        nas <- which(is.na(dat$disc))
        dat <- dat[-nas, ]
        nas_txt <- paste(nas, collapse=', ')
        nas_txt <- paste('Removed row(s)', nas_txt, 'because disc-column
                         contains non-numeric values', sep=' ')
        output$nas <- shiny::renderPrint({
          cat(nas_txt)
        })
      }
      if (!is.null(input$disc_limit)) {
        dat <- check_conc(dat, disc_lim=input$disc_limit)
      }
      if (is.null(nas)) {
        output$nas <- shiny::renderPrint({
          cat('')
        })
      }
    }
    if (input$sample_freq) {
      if ('hfhf' %in% names(dat)) {
        hf <- dat[which(!is.na(dat$hfhf)), ]
        n_hf <- aggregate(hf$sample, by = hf['sample'], length)
      }
      if ('ehf_i' %in% names(dat)) {
        hf <- dat[which(!is.na(dat$ehf_i)), ]
        n_hf <- aggregate(hf$sample, by = dat['sample'], length)
      }
      if (!is.null(input$disc_limit)) {
        dat1 <- check_conc(dat, disc_lim=input$disc_limit)
        n_conc <- aggregate(dat1$sample, by = dat1['sample'], length)
      }
      if (is.null(n_conc) &
          is.null(n_hf)) {
        output$numbers <- shiny::renderTable({
          names(n_analyses) <- c('sample', 'n_analyses')
          n_analyses
        })
      }
      if (!is.null(n_conc) & (is.null(n_hf))) {
        output$numbers <- shiny::renderTable({
          numbers <- merge(n_analyses, n_conc, by = 'sample')
          names(numbers) <- c('sample', 'n_analyses', 'n_conc')
          numbers
        })
      }
      if (!is.null(n_hf) & is.null(n_conc)) {
        output$numbers <- shiny::renderTable({
          numbers <- merge(n_analyses, n_hf, by = 'sample')
          names(numbers) <- c('sample', 'n_analyses', 'n_hf')
          numbers
        })
      }
      if (!is.null(n_hf) & !is.null(n_conc)) {
        output$numbers <- shiny::renderTable({
          numbers <- merge(n_analyses, n_conc, by = 'sample')
          numbers <- merge(numbers, n_hf, by = 'sample')
          names(numbers) <- c('sample', 'n_analyses', 'n_conc', 'n_hf')
          numbers
        })
      }
    } else {
      numbers <- NULL
      output$numbers <- shiny::renderTable({
        numbers
      })
    }
    return(dat)
  })
  likeness_table <- shiny::reactive({
    new_data <- csv_data()
    if (!is.null(new_data)) {
      constants <- c(
        input$lambda_lu,
        input$hfhf_chur,
        input$luhf_chur,
        input$hfhf_dm,
        input$luhf_dm,
        input$luhf_zrc
      )
      if(!is.null(input$likeness_samples)) {
        new_data <- new_data[new_data$sample %in% input$likeness_samples, ]
        new_data$sample <- factor(new_data$sample,
                                  levels=input$likeness_samples)
      }
      if (input$likeness_type == '1d') {
        satkoski_1d_matrix(new_data, bw=input$likeness_age_bw)
      } else {
        if (input$likeness_type == '2d') {
          hf_data <- calc_hf(new_data, constants=constants)
          satkoski_2d_matrix(hf_data, bw=c(input$likeness_age_bw,
                                           input$likeness_ehf_bw))
        } else {
          if (input$likeness_type == 'combine') {
            hf_data <- calc_hf(new_data, constants=constants)
            one_d <- satkoski_1d_matrix(new_data, bw=input$likeness_age_bw)
            two_d <- satkoski_2d_matrix(hf_data, bw=c(input$likeness_age_bw,
                                                   input$likeness_ehf_bw))
            combine_matrices(one_d, two_d)
          }
        }
      }
    }
  })

  o_table <- shiny::reactive({
    new_data <- csv_data()
    if (!is.null(new_data)) {
      constants <- c(
        input$lambda_lu,
        input$hfhf_chur,
        input$luhf_chur,
        input$hfhf_dm,
        input$luhf_dm,
        input$luhf_zrc
      )
      if(!is.null(input$o_samples)) {
        new_data <- new_data[new_data$sample %in% input$o_samples, ]
        new_data$sample <- factor(new_data$sample,
                                  levels=input$o_samples)
      }
      if (input$o_type == 'age') {
        o_param_matrix_age(new_data)

      } else {
        if (input$o_type == 'tdm') {
          hf_data <- calc_hf(new_data, constants=constants)
          o_param_matrix_tdm(hf_data)
        } else {
          if (input$o_type == 'combine') {
            hf_data <- calc_hf(new_data, constants=constants)
            combine_matrices(o_param_matrix_age(new_data),
                             o_param_matrix_tdm(hf_data))
          }
        }
      }
    }
  })

  o_plot <- shiny::reactive({
    new_data <- csv_data()
    if (!is.null(new_data)) {
      constants <- c(
        input$lambda_lu,
        input$hfhf_chur,
        input$luhf_chur,
        input$hfhf_dm,
        input$luhf_dm,
        input$luhf_zrc
      )
      if ('hfhf' %in% names(new_data)) {
        hf_data <- calc_hf(new_data, constants=constants)
      }
      if(!is.null(input$o_samples)) {
        new_data <- new_data[new_data$sample %in% input$o_samples,]
        new_data$sample <- factor(new_data$sample,
                                  levels=input$o_samples)

        if ('hfhf' %in% names(new_data)) {
          hf_data <- hf_data[hf_data$sample %in% input$o_samples, ]
          hf_data$sample <- factor(hf_data$sample,
                                    levels=input$o_samples)
        }

      }
      if ('hfhf' %in% names(new_data)) {
        dat <- list(age=new_data, hf=hf_data)
      } else {
        dat <- list(age=new_data)
      }
      plot_tile(dat, type=input$o_type) +
        plot_text_options(font_name = input$font_name,
                          title_size = input$title_size,
                          label_size = input$label_size,
                          legend_size = input$legend_size,
                          strip_text_y_size = input$strip_size)
    }
  })

  reimink_plot <- shiny::reactive({
    new_data <- reimink_table()
    if (!is.null(new_data)) {
      plot_reimink(new_data) +
        plot_text_options(font_name = input$font_name,
                          title_size = input$title_size,
                          label_size = input$label_size,
                          legend_size = input$legend_size,
                          strip_text_y_size = input$strip_size)
    }
  })

  reimink_table <- shiny::reactive({
    new_data <- csv_data()
    if (!is.null(new_data)) {
      if(!is.null(input$reimink_samples)) {
        new_data <- new_data[new_data$sample %in% input$reimink_samples, ]
        new_data$sample <- factor(new_data$sample,
                                  levels=input$reimink_samples)
      }
      reimink_data <- reimink(new_data, input$reimink_step)
    }
  })

  hf_table <- shiny::reactive({
    new_data <- csv_data()
    constants <- c(
      input$lambda_lu,
      input$hfhf_chur,
      input$luhf_chur,
      input$hfhf_dm,
      input$luhf_dm,
      input$luhf_zrc
    )
    hf_data <- calc_hf(new_data, constants=constants)
  })
  dens_plot <- shiny::reactive({
    new_data <- csv_data()
    if (!is.null(new_data)) {
       facet <- NULL
      if (input$dens_type == 'dens_combine') {
        facet <- FALSE
        if (!is.null(input$dens_combine_choice)) {
          new_data <- new_data[(new_data$sample %in%
                                  input$dens_combine_choice) ,]
        }
      }
      if (input$dens_type == 'dens_facet') {
        facet <- TRUE
        if (!is.null(input$dens_facet_choice)) {
          new_data <- new_data[(new_data$sample %in% input$dens_facet_choice), ]
          new_data$sample <- factor(new_data$sample,
                                    levels = input$dens_facet_choice)
        }
      }
      if (input$dens_type == 'dens_ind') {
        facet <- FALSE
        if (!is.null(input$dens_ind_choice)) {
          new_data <- new_data[new_data$sample == input$dens_ind_choice, ]
        }
      }
       if (input$hist == TRUE) {
         p <- plot_dens_hist(new_data, binwidth=input$binwidth, bw=input$bw,
                             type=input$type, age_range=c(input$xstart, input$xstop),
                             facet=facet, fixed_y=input$fixed_y,
                             step=input$xstep) +
           plot_text_options(font_name = input$font_name,
                             title_size = input$title_size,
                             label_size = input$label_size,
                             legend_size = input$legend_size,
                             strip_text_y_size = input$strip_size)
       } else {
         p <- plot_dens(new_data, bw=input$bw,
                        type=input$type, age_range=c(input$xstart, input$xstop),
                        facet=facet, fixed_y=input$fixed_y, step=input$xstep) +
           plot_text_options(font_name = input$font_name,
                             title_size = input$title_size,
                             label_size = input$label_size,
                             legend_size = input$legend_size,
                             strip_text_y_size = input$strip_size)
       }
    }
  })
  ecdf_plot <- shiny::reactive({
    new_data <- csv_data()
    if (!is.null(new_data)) {
      mult_ecdf <- NULL
      constants <- c(
        input$lambda_lu,
        input$hfhf_chur,
        input$luhf_chur,
        input$hfhf_dm,
        input$luhf_dm,
        input$luhf_zrc
      )
      if (input$ecdf_input_type == 't_dm2') {
        new_data <- calc_hf(new_data, constants=constants)
      }
      if (input$ecdf_type == 'ind_plot') {
        mult_ecdf <- FALSE
        if (!is.null(input$ecdf_ind_samples)) {
          new_data <- new_data[new_data$sample == input$ecdf_ind_samples, ]
        }
      }
      if (input$ecdf_type == 'same_plot') {
        mult_ecdf <- TRUE
        if (length(input$ecdf_mult_samples) > 0) {
          new_data <- new_data[new_data$sample %in% input$ecdf_mult_samples, ]
        }
      }
      if (input$ecdf_type == 'ecdf_combine_plot') {
        mult_ecdf <- FALSE
        if (!is.null(input$ecdf_comb_samples)) {
          new_data <- new_data[new_data$sample %in% input$ecdf_comb_samples, ]
        }
      }
      p <- plot_ecdf(new_data, mult_ecdf=mult_ecdf, conf=input$ecdf_conf,
                     column=input$ecdf_input_type, guide=input$ecdf_legend) +
        plot_axis_lim(xlim=c(input$ecdf_xstart, input$ecdf_xstop),
                      step=input$ecdf_xstep) +
        plot_text_options(font_name = input$font_name,
                            title_size = input$title_size,
                            label_size = input$label_size,
                            legend_size = input$legend_size)
    }
  })
  hf_plot <- shiny::reactive({
    new_data <- csv_data()
    if (!is.null(new_data)) {
      constants <- c(
        input$lambda_lu,
        input$hfhf_chur,
        input$luhf_chur,
        input$hfhf_dm,
        input$luhf_dm,
        input$luhf_zrc
      )
      new_data <- calc_hf(new_data, constants=constants)
      if (input$hf_type == 'ehf_plot') {
        contour_data <- NULL
        if (input$error_bars) {
          if (input$x_error_bars) {
            x_errors <- data.frame(xmin=new_data$age-(2*new_data$uncert),
                                   xmax=new_data$age+(2*new_data$uncert))
            new_data <- cbind(new_data, x_errors)
          }
          if (input$y_error_bars) {
            y_errors <- data.frame(ymin=new_data$ehf_i-new_data$ehf_2se,
                                   ymax=new_data$ehf_i+new_data$ehf_2se)
            new_data <- cbind(new_data, y_errors)
          }
        }
        if (input$add_contours) {
          contour_data <- new_data[new_data$sample %in% input$contour_choice, ]
        }
        if(!is.null(input$hfhf_samples)) {
          new_data <- new_data[new_data$sample %in% input$hfhf_samples, ]
          new_data$sample <- factor(new_data$sample,
                                    levels=input$hfhf_samples)
        }
        p <- plot_hf(new_data, guide=input$hf_legend,
                     contours=input$add_contours,
                     x_bandwidth=input$contour_x_bandwidth,
                     y_bandwidth=input$contour_y_bandwidth,
                     contour_data=contour_data,
                     combine_contours=input$combine_contours,
                     error_bars=input$error_bars,
                     x_errors=input$x_error_bars, y_errors=input$y_error_bars,
                     constants=constants) +
          plot_axis_lim(xlim=c(input$hf_xstart, input$hf_xstop),
                        ylim=input$ehf_ylim,
                        step=input$hf_xstep) +
          plot_text_options(font_name = input$font_name,
                            title_size = input$title_size,
                            label_size = input$label_size,
                            legend_size = input$legend_size)
      } else {
        if (input$hf_type == 'hfhf_plot') {
          contour_data <- NULL
          if (input$error_bars) {
            if (input$x_error_bars) {
              x_errors <- data.frame(xmin=new_data$age-(2*new_data$uncert),
                                     xmax=new_data$age+(2*new_data$uncert))
              new_data <- cbind(new_data, x_errors)
            }
            if (input$y_error_bars) {
              y_errors <- data.frame(ymin=new_data$hf_i-new_data$hf_2se,
                                     ymax=new_data$hf_i+new_data$hf_2se)
              new_data <- cbind(new_data, y_errors)
            }
          }
          if (input$add_contours) {
            contour_data <-
              new_data[new_data$sample %in% input$contour_choice, ]
          }
          if(!is.null(input$hfhf_samples)) {
            new_data <- new_data[new_data$sample %in% input$hfhf_samples, ]
            new_data$sample <- factor(new_data$sample, levels=
                                        input$hfhf_samples)
          }
          p <- plot_hf(new_data, plot_type = 'hfhf', guide=input$hf_legend,
                       contours=input$add_contours,
                       x_bandwidth=input$contour_x_bandwidth,
                       y_bandwidth=input$contour_y_bandwidth,
                       contour_data=contour_data,
                       combine_contours=input$combine_contours,
                       error_bars=input$error_bars,
                       x_errors=input$x_error_bars, y_errors=input$y_error_bars,
                       constants=constants) +
            plot_axis_lim(xlim=c(input$hf_xstart, input$hf_xstop),
                          ylim=input$hf_ylim,
                          step=input$hf_xstep) +
            plot_text_options(font_name = input$font_name,
                                title_size = input$title_size,
                                label_size = input$label_size,
                                legend_size = input$legend_size)
        }
      }
    }
  })

  uqlq_plot <- shiny::reactive({
    new_data <- csv_data()
    if (!is.null(new_data)) {
      constants <- c(
        input$lambda_lu,
        input$hfhf_chur,
        input$luhf_chur,
        input$hfhf_dm,
        input$luhf_dm,
        input$luhf_zrc
      )
      mix_data = NULL
      if (input$mixing_model) {
        mix_data <- dzr_mix(input$mu1, input$sig1, input$mu2, input$sig2)
      }
      if(!is.null(input$quant_samples)) {
        new_data <- new_data[new_data$sample %in% input$quant_samples, ]
        new_data$sample <- factor(new_data$sample,
                                  levels=input$quant_samples)
      }
      if (input$uqlq_type == 'uqlq_age') {
        column = 'age'
      }
      if (input$uqlq_type == 'uqlq_tdm') {
        new_data <- calc_hf(new_data, constants=constants)
        column = 't_dm2'
      }
      p <- plot_quantiles(new_data, column=column, guide=input$uqlq_legend,
                          conf=input$uqlq_conf, mix=input$mixing_model,
                          mix_data=mix_data)
      p <- p + plot_axis_lim(xlim=c(input$uqlq_xstart, input$uqlq_xstop),
                             step=input$uqlq_xstep,
                             ylim=c(input$uqlq_ystart, input$uqlq_ystop))
      p <- p + plot_text_options(font_name = input$font_name,
                                 title_size = input$title_size,
                                 label_size = input$label_size,
                                 legend_size = input$legend_size)
    }
  })
  # Output
  output$head <- DT::renderDataTable(DT::datatable({
    new_data <- csv_data()
    new_data
  }))

  output$dens_plot <- shiny::renderPlot({
    print(dens_plot())
  })
  output$ecdf_plot <- shiny::renderPlot({
    print(ecdf_plot())
  })
  output$reimink_plot <- shiny::renderPlot({
    print(reimink_plot())
  })
  output$downloadDensplot <- shiny::downloadHandler(
    filename = function(){
      paste('kde-', format(Sys.time(), "%d%m%y-%H%M%S"), '.pdf', sep='')

    },
    content = function(file) {
      ggplot2::ggsave(file, plot = dens_plot(), width=input$densWidth,
                      height=input$densHeight, colormodel='cmyk', units='cm')
    }
  )
  output$download_ecdf_plot <- shiny::downloadHandler(
    filename = function(){
      paste('ecdf-', format(Sys.time(), "%d%m%y-%H%M%S"), '.pdf', sep='')

    },
    content = function(file) {
      ggplot2::ggsave(file, plot = ecdf_plot(), width=input$ecdf_width,
                      height=input$ecdf_height, colormodel='cmyk', units='cm')
    }
  )
  output$download_hf_plot <- shiny::downloadHandler(
    filename = function(){
      paste('hf-', format(Sys.time(), "%d%m%y-%H%M%S"), '.pdf', sep='')

    },
    content = function(file) {
      ggplot2::ggsave(file, plot = hf_plot(), width=input$hf_width,
                      height=input$hf_height, colormodel='cmyk', units='cm',
                      useDingbats=FALSE)
    }
  )
  output$download_uqlq_plot <- shiny::downloadHandler(
    filename = function(){
      paste('uqlq-', format(Sys.time(), "%d%m%y-%H%M%S"), '.pdf', sep='')

    },
    content = function(file) {
      ggplot2::ggsave(file, plot = uqlq_plot(), width=input$uqlq_width,
                      height=input$uqlq_height, colormodel='cmyk', units='cm',
                      useDingbats=FALSE)
    }
  )
  output$download_likeness_table <- shiny::downloadHandler(
    filename = function(){
      paste('likeness-', format(Sys.time(), "%d%m%y-%H%M%S"), '.csv', sep='')

    },
    content = function(file) {
      utils::write.csv(likeness_table(), file, row.names = FALSE)
    }
  )
  output$download_satkoski_2d <- shiny::downloadHandler(
    filename = function(){
      paste('L2-', format(Sys.time(), "%d%m%y-%H%M%S"), '.csv', sep='')

    },
    content = function(file) {
      utils::write.csv(satkoski_2d_table(), file, row.names = FALSE)
    }
  )
  output$download_o_table <- shiny::downloadHandler(
    filename = function(){
      paste('otable-', format(Sys.time(), "%d%m%y-%H%M%S"), '.csv', sep='')

    },
    content = function(file) {
      utils::write.csv(o_table(), file, row.names = FALSE)
    }
  )
  output$download_o_plot <- shiny::downloadHandler(
    filename = function(){
      paste('oplot-', format(Sys.time(), "%d%m%y-%H%M%S"), '.pdf', sep='')

    },
    content = function(file) {
      ggplot2::ggsave(file, plot = o_plot(), width=input$o_width,
                      height=input$o_height, colormodel='cmyk', units='cm')
    }

  )
  output$download_reimink_plot <- shiny::downloadHandler(
    filename = function(){
      paste('reimink-', format(Sys.time(), "%d%m%y-%H%M%S"), '.pdf', sep='')

    },
    content = function(file) {
      ggplot2::ggsave(file, plot = reimink_plot(), width=input$reimink_width,
                      height=input$reimink_height, colormodel='cmyk',
                      units='cm')
    }
  )
  output$download_reimink_table <- shiny::downloadHandler(
    filename = function(){
      paste('likelihood-', format(Sys.time(), "%d%m%y-%H%M%S"), '.csv', sep='')

    },
    content = function(file) {
      utils::write.csv(reimink_table(), file, row.names = FALSE)
    }
  )
  output$download_hf_table <- shiny::downloadHandler(
    filename = function(){
      paste('hf-', format(Sys.time(), "%d%m%y-%H%M%S"), '.csv', sep='')

    },
    content = function(file) {
      utils::write.csv(hf_table(), file, row.names = FALSE)
    }
  )
  output$dens_facet_select <- shiny::renderUI({
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    selectInput('dens_facet_choice', 'Select samples', samples,
                multiple=TRUE, selectize=TRUE)
  })
  output$show_disc_limit <- shiny::renderUI({
    if (input$disc) {
      shiny::numericInput('disc_limit', 'Discordancy limit (%)', 10,
                          min=0, max=100)
      }
  })
  # Dynamic UI density tab
  output$dens_switch <- shiny::renderUI({
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    if (input$dens_type == 'dens_facet') {
      selectInput('dens_facet_choice', 'Select samples', samples,
                  multiple=TRUE, selectize=TRUE)
    } else {
      if (input$dens_type == 'dens_ind') {
        selectInput('dens_ind_choice', 'Select sample', samples)
      } else {
      if (input$dens_type == 'dens_combine') {
        selectInput('dens_combine_choice', 'Select samples', samples,
                    multiple=TRUE, selectize=TRUE)
      }
      }
    }
  })
  # Dynamic UI ecdf tab
  output$ecdf_switch <- shiny::renderUI({
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    if (input$ecdf_type == 'same_plot') {
      selectInput('ecdf_mult_samples', 'Select samples', samples,
                  multiple=TRUE, selectize=TRUE)
    } else {
      if (input$ecdf_type == 'ind_plot') {
        selectInput('ecdf_ind_samples', 'Select sample', samples)
      } else {
        if (input$ecdf_type == 'ecdf_combine_plot') {
          selectInput('ecdf_comb_samples', 'Select samples', samples,
                      multiple=TRUE, selectize=TRUE)
        }
      }
    }
  })
  # Dynamic UI Lu-Hf tab
  output$hf_switch <- shiny::renderUI({
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    if (input$hf_type == 'ehf_plot') {
      shiny::sliderInput('ehf_ylim', 'Y-axis range',
                         min=-50, max=50, value = c(-20, 20))
    } else {
      if (input$hf_type == 'hfhf_plot') {
        shiny::sliderInput('hf_ylim', 'Y-axis range',
                           min=0.279, max=0.2833, value = c(0.28, 0.2831))
        }
      }
  })
  output$hf_bandwidths <- shiny::renderUI({
    if (input$hf_type == 'ehf_plot') {
      shiny::conditionalPanel(
        condition = 'input.add_contours == true',
        shiny::numericInput('contour_x_bandwidth', 'X bandwidth', 30),
        shiny::numericInput('contour_y_bandwidth', 'Y bandwidth', 2.5),
        shiny::checkboxInput('combine_contours',
                             label = 'Combine contours',
                             value = FALSE)
      )
    } else {
      if (input$hf_type == 'hfhf_plot') {
        shiny::conditionalPanel(
          condition = 'input.add_contours == true',
          shiny::numericInput('contour_x_bandwidth', 'X bandwidth', 30),
          shiny::numericInput('contour_y_bandwidth', 'Y bandwidth', 0.00025),
          shiny::checkboxInput('combine_contours',
                               label = 'Combine contours',
                               value = FALSE)
        )
      }
    }
  })
  # Dynamic UI O-tab
  output$o_switch <- shiny::renderUI({
    if (input$o_fig) {
      shiny::verticalLayout(
        shiny::tableOutput('o_table'),
        shiny::plotOutput('o_plot')
      )
    } else {
      shiny::tableOutput('o_table')
    }
  })
  output$contour_switch <- shiny::renderUI({
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    if (input$add_contours) {
      selectInput('contour_choice', 'Select samples to contour', samples,
                  multiple=TRUE, selectize=TRUE)
    }
  })
  output$hf_samples <- shiny::renderUI({
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    shiny::selectInput('hfhf_samples', 'Select samples', samples,
                       multiple=TRUE, selectize=TRUE)
  })
  output$hf <- shiny::renderPlot({
    print(hf_plot())
  })
  output$uqlq_samples <- shiny::renderUI({
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    shiny::selectInput('quant_samples', 'Select samples', samples,
                       multiple=TRUE, selectize=TRUE)
  })
  output$o_samples <- shiny::renderUI({
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    shiny::selectInput('o_samples', 'Select samples', samples,
                       multiple=TRUE, selectize=TRUE)
  })
  output$likeness_samples <- shiny::renderUI({
    constants <- c(
      input$lambda_lu,
      input$hfhf_chur,
      input$luhf_chur,
      input$hfhf_dm,
      input$luhf_dm,
      input$luhf_zrc
    )
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    shiny::selectInput('likeness_samples', 'Select samples', samples,
                       multiple=TRUE, selectize=TRUE)
  })
  output$uqlq <- shiny::renderPlot({
    print(uqlq_plot())
  })
  output$likeness <- shiny::renderTable({
    likeness_table()
  }, rownames=TRUE)
  output$likeness_bw <- shiny::renderUI({
    if (input$likeness_type == '2d' | input$likeness_type == 'combine') {
      shiny::numericInput('likeness_ehf_bw', 'Epsilon-Hf bandwidth', 2.5)
    }
  })
  output$o_plot <- shiny::renderPlot({
    print(o_plot())
  })
  output$o_table <- shiny::renderTable({
    o_table()
  }, rownames=TRUE)

  output$reimink_samples <- shiny::renderUI({
    new_data <- csv_data()
    samples <- as.vector(unique(new_data$sample))
    shiny::selectInput('reimink_samples', 'Select samples', samples,
                       multiple=FALSE, selectize=FALSE)
  })
  output$reimink_maxima_lower <- shiny::renderText({
    reimink_data <- reimink_table()
    if (!is.null(reimink_data)) {
        lower <- reimink_data[reimink_data$type == 'lower',]
        lower_maxima <- find_maxima(lower$y, 0, 1)
        lower[lower_maxima, ]$x
    }
  })
  output$reimink_maxima_upper <- shiny::renderText({
    reimink_data <- reimink_table()
    if (!is.null(reimink_data)) {
        upper <- reimink_data[reimink_data$type == 'upper',]
        upper_maxima <- find_maxima(upper$y, 0, 1)
        upper[upper_maxima, ]$x
    }
  })
})

# Run the application
shiny::shinyApp(ui = ui, server = server)
magnuskristoffersen/detzrcr documentation built on Nov. 17, 2022, 12:48 a.m.