# sample-size-hint variable
library(tidyverse)
library(shiny)
library(rhandsontable)
library(magrittr)
library(ggplot2)
library(knitr)
library(plotly)
library(boot)
library(pander)
library(rmarkdown)
library(leistungstests)
#library(shinyjs)
# set upload-size limit to max
options(shiny.maxRequestSize=30*1024^2)
shinyServer(function(input, output, session) {
# APP-DATA DEFINITION -----------------
ostit <- reactiveValues(
#raw-data setup as tibble
raw_data = tibble(valid = TRUE, Messwert = as.numeric(rep(NA, 7)), Kommentar = ""),
messwerte = NA,
valid_data = NA,
# meta-data
variable_name = "",
variable_unit = "",
# dokumentation
versuchsziel = "",
sollwert = "",
versuchsbeschreibung = "",
ergebnis = "",
schlussfolgerung = "",
# test-spec
spec = 0,
spec_type = "lsl",
p_min = 95,
power = 75,
# statistics
sample_size = 0,
sample_mean = NA,
sample_sd = NA,
kc = NA,
ltl = NA,
utl = NA,
nr_io_items = NA,
test_result = NA,
estimated_process_good = NA,
# design-aid ostit
p_pass_desired = 98,
sample_size_desired = 3
)
# APP-DATA EVENT-HANDLING -----------------
observe({
# messwert handling
if (!is.null(input$raw_data)){# in app-start-up input$raw_data is null!
ostit$raw_data <- as_tibble(hot_to_r(input$raw_data))
}
# valid-data enthält ausgewählte observationen und !is.na(Messwerte)
# valid_data hat zwei-Variablen: obsNr[numeric], Messwerte[numeric]
ostit$valid_data <-
ostit$raw_data %>%
#rownames_to_column(var = "obsNr") %>% # does not work as row-names are stored as character-vector
mutate(obsNr = as.numeric(row.names(ostit$raw_data))) %>%
filter(valid & !is.na(Messwert)) %>%
select(obsNr, Messwert)
# meta-data
ostit$variable_name <- input$variable_name
ostit$variable_unit <- input$variable_unit
# dokumentation
ostit$versuchsziel <- input$versuchsziel
ostit$sollwert <- input$sollwert
ostit$versuchsbeschreibung <- input$versuchsbeschreibung
ostit$ergebnis <- input$ergebnis
ostit$schlussfolgerung <- input$schlussfolgerung
# test-spec
ostit$spec <- input$spec
ostit$spec_type <- input$spec_type
ostit$p_min <- input$p_min/100
ostit$power <- input$power/100
# statistics
ostit$sample_size <- ostit$raw_data %>% filter(valid & !is.na(Messwert)) %>% nrow()
ostit$sample_mean <- ostit$raw_data %>% filter(valid & !is.na(Messwert)) %$% mean(Messwert)
ostit$sample_sd <- ostit$raw_data %>% filter(valid & !is.na(Messwert)) %$% sd(Messwert)
ostit$kc <- kc(p = ostit$p_min, alpha = (1 - ostit$power), n = ostit$sample_size)
ostit$ltl <- ostit$sample_mean - ostit$kc * ostit$sample_sd
ostit$utl <- ostit$sample_mean + ostit$kc * ostit$sample_sd
ostit$nr_io_items <-
if_else(ostit$spec_type == "lsl",
ostit$raw_data %>% filter(valid & !is.na(Messwert)) %$% sum(Messwert > ostit$spec),
ostit$raw_data %>% filter(valid & !is.na(Messwert)) %$% sum(Messwert < ostit$spec)
)
ostit$test_result <- ifelse(ostit$spec_type == "lsl",
ifelse(ostit$ltl > ostit$spec, "bestanden", "nicht bestanden"),
ifelse(ostit$utl < ostit$spec, "bestanden", "nicht bestanden"))
ostit$estimated_process_good <-
if_else(ostit$spec_type == "lsl",
if_else(ostit$sample_mean - qnorm(ostit$p_min) * ostit$sample_sd < ostit$spec, FALSE, TRUE),
if_else(ostit$sample_mean + qnorm(ostit$p_min) * ostit$sample_sd > ostit$spec, FALSE, TRUE))
# setup test-design
ostit$p_pass_desired <- input$p_pass_desired/100
ostit$sample_size_desired <- input$sample_size_desired
})
#INIT DATA DISPLAY ------------
output$raw_data <- renderRHandsontable({ rhandsontable(ostit$raw_data)})
# dies wird nur zum programm start ausgeführt !!!! ????
# this is simply to register the rhandsontable with the output/display
# VARIABLE ------------
source(file.path("design_aid", "server_design_aid_plot.R"), local = TRUE, encoding = "UTF-8")$value
source(file.path("qq_plot", "server_qq_plot.R"), local = TRUE, encoding = "UTF-8")$value
source(file.path("auswertung", "server_messwert_plot.R"), local = TRUE, encoding = "UTF-8")$value
# DOKUMENATION ------------
# HELP pages
source(file.path("dokumentation", "help_dialogs.R"), local = TRUE, encoding = "UTF-8")$value
# LOAD/SAVE
source(file.path("dokumentation", "server_load_save.R"), local = TRUE, encoding = "UTF-8")$value
# GENERATE REPORTS
source(file.path("dokumentation", "server_gen_reports.R"), local = TRUE, encoding = "UTF-8")$value
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.