app/app.R

In debruine/pipeline: Machine-Readable Studies

## app.R ##
library(shiny)
library(shinyjs)
library(shinydashboard)
library(DT)
library(pipeline)
library(dplyr)
library(tidyr)
options("scipen"=10, "digits"=4)

## Functions ----


## Interface Tab Items ----

start_tab <- tabItem(
  tabName = "start_tab",
  h3("Getting Started"),
  textInput("study_name", "Study Name"),
  textAreaInput("study_desc", "Study Description")
)

hypo_tab <- tabItem(
  tabName = "hypo_tab",
  h3("Hypotheses"),
  textAreaInput("hypo_desc", "Hypothesis Description"),
  selectInput("hypo_test", "Analysis", c("Analysis 1")),
  h4("Criteria"),
  fluidRow(
    column(width = 4, textInput("hypo_result", NULL, "p_value", NULL, "Result")),
    column(width = 2, selectInput("hypo_direction", NULL, c("<", "=", ">", "!="), "<")),
    column(width = 4, textInput("hypo_comparator", NULL, "0.05", NULL, "Comparator")),
    column(width = 2, actionButton("add_criterion", "Add Criterion", icon("plus")))
  ),
  actionButton("add_hypothesis", "Add Hypothesis", icon("plus"))
)

meth_tab <- tabItem(
  tabName = "meth_tab",
  h3("Methods")
)

data_tab <- tabItem(
  tabName = "data_tab",
  h3("Data")
)

anal_tab <- tabItem(
  tabName = "anal_tab",
  h3("Analyses"),
  textInput("anal_name", "Analysis Name", "Analysis 1", "100%"),
  selectInput("anal_test", "Test Function",
              c("t.test",
                "cor.test",
                "effect_size_d_paired",
                "custom")),
  h4("Parameters"),
  DTOutput("param_table"),
  actionButton("add_param", "Add Parameter", icon("plus")),
  textAreaInput("anal_desc", "Custom Analysis Function", "", "100%"),
  actionButton("add_analysis", "Add Analysis", icon("plus"))
)

about_tab <- tabItem(
  tabName = "about_tab",
  h3("About this App"),
  p("Stuff about this")
)

## UI ----
ui <- dashboardPage(
  dashboardHeader(title = "Pipeline"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Start", tabName = "start_tab"),
      menuItem("Hypotheses", tabName = "hypo_tab"),
      #menuItem("Methods", tabName = "meth_tab"),
      menuItem("Data", tabName = "data_tab"),
      menuItem("Analysis", tabName = "anal_tab"),
      menuItem("About", tabName = "about_tab")
    )
  ),
  dashboardBody(
    useShinyjs(),
    tags$head(
      tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
    ),
    tabItems(
      start_tab,
      hypo_tab,
      #meth_tab,
      data_tab,
      anal_tab,
      about_tab
    )
  )
)

## server ----
server <- function(input, output, session) {
  func.params <- list(
    t.test = list(
      x = ".data$x",
      y = ".data$y",
      alternative = "two.sided",
      mu = 0,
      paired = FALSE,
      var.equal = FALSE,
      conf.level = 0.95
    ),
    cor.test = list(
      x = ".data$x",
      y = ".data$y",
      alternative = "two.sided",
      method = "pearson",
      conf.level = 0.95
    )
  )


  output$param_table <- renderDataTable({
    param_table <- data.frame(
      parameter = func.params[[input$anal_test]] %>% names(),
      value = func.params[[input$anal_test]] %>% unlist() %>% unname()
    )

    datatable(param_table, editable = TRUE, rownames = T)
  })
} # end server()

shinyApp(ui, server)