inst/apps/samplesize_determination_variable/auswertung/server_messwert_plot.R

In stephanGit/leistungstests: Supplies Functions to calculate 'leistungstests'

# scales messwerte plot --------------
plot_scales_messwerte <- reactive({
  if (input$scaling_messwerte_plot == "manual"){
    mean_min <- input$mean_min_messwerte
    mean_max <- input$mean_max_messwerte
    first_obs <- input$first_obs
    last_obs <- input$last_obs
  }else
  {
    mean_min <- ifelse( is.na(min(ostit$valid_data$Messwert)), -1, min(c(ostit$valid_data$Messwert, ostit$spec, ostit$ltl), na.rm = TRUE) )
    mean_max <- ifelse( is.na(max(ostit$valid_data$Messwert)), 1, max(c(ostit$valid_data$Messwert, ostit$spec, ostit$utl), na.rm = TRUE) )
    first_obs <- min(ostit$valid_data$obsNr)
    last_obs <- max(ostit$valid_data$obsNr)
    updateNumericInput(session, "mean_min_messwerte", value = round(mean_min))
    updateNumericInput(session, "mean_max_messwerte", value = round(mean_max))
  }

  return(list(
    mean = c(mean_min, mean_max),
    obs_range = c(first_obs, last_obs)
  ))

})


# messwerte plot  ------------------
output$messwerte_plot <- renderPlot({

  validate(need(ostit$spec, 'Bitte Spezifikations-Grenze(n) angeben'))

  ggplot_object <-
    ostit$valid_data %>%
    ggplot() +
    geom_point(aes(x = obsNr, y = Messwert), color = "blue", shape = 4, size = 4) +
    scale_x_continuous(limits = plot_scales_messwerte()$obs_range) +
    scale_y_continuous(limits = plot_scales_messwerte()$mean) +
    geom_hline(yintercept = ostit$spec, color = "red") +
    geom_text(x = plot_scales_messwerte()$obs_range[2], y = ostit$spec, label = "Spec-Limit", vjust = 0, hjust = 1)

  if (!is.na(ostit$sample_mean)){
    ggplot_object <-
      ggplot_object +
      geom_hline(yintercept = ostit$sample_mean, color = "black") +
      geom_text(x = sum(plot_scales_messwerte()$obs_range)/2, y = ostit$sample_mean, label = "Sample-Mean", vjust = 0, hjust = 0)
  }

  if (!is.na(ostit$sample_sd)){
    ggplot_object <-
      ggplot_object +
      geom_hline(yintercept = 3*c(-ostit$sample_sd, ostit$sample_sd) + ostit$sample_mean,
                 color = "black", linetype = "dashed") +
      geom_text(x = sum(plot_scales_messwerte()$obs_range)/2, y = 3 * ostit$sample_sd + ostit$sample_mean,
                label = "Mean + 3 * sd (six-sigma!)", vjust = 0, hjust = 0) +
      geom_text(x = sum(plot_scales_messwerte()$obs_range)/2, y = -3 * ostit$sample_sd + ostit$sample_mean,
                label = "Mean - 3 * sd (six-sigma!)", vjust = 0, hjust = 0)
  }

  if ( !is.na(ostit$ltl) & ostit$spec_type == "lsl"){
    ggplot_object <-
      ggplot_object +
      geom_hline(yintercept = ostit$ltl, color = "green") +
      geom_text(x = plot_scales_messwerte()$obs_range[1], y = ostit$ltl, label = "lower Tol. Limit", vjust = 0, hjust = 0)
  }

  if ( !is.na(ostit$utl) & ostit$spec_type == "usl"){
    ggplot_object <-
      ggplot_object +
      geom_hline(yintercept = ostit$utl, color = "green") +
      geom_text(x = plot_scales_messwerte()$obs_range[1], y = ostit$utl, label = "upper Tol. Limit", vjust = 0, hjust = 0)
  }

  ggplot_object +
    labs(
      title = paste("Stichproben-Mittelwert: ", round(ostit$sample_mean, 2), ostit$variable_unit,
                    "; Stichproben-Standardabweichung: ", round(ostit$sample_sd,2), ostit$variable_unit),
      x = "Reihenfolge der Datenerhebung",
      y = paste(ostit$variable_name, " [", ostit$variable_unit, "]", sep = "")
    )

})


# verbatim test result ---------------
output$verbatim_test_result <- renderUI({
  {
    result_style <- ifelse( ostit$test_result == "bestanden", "style='color:green'", "style='color:red'" )
    tags$div(

      tagList(
        tags$ol(
          tags$li("Stichproben-Mittelwert: ", tags$b(round(ostit$sample_mean,2))),
          tags$li("Stichproben-Standardabweichung: ", tags$b(round(ostit$sample_sd,2))),
          # tags$li("kc-Faktor (ISO 16269 C1-C4): ", round(ostit$kc,3)),
          # if (ostit$spec_type == "lsl") tags$li("Lower Tol. Limit (ISO 16269): ", round(ostit$ltl,2)),
          # if (ostit$spec_type == "usl") tags$li("Upper Tol. Limit (ISO 16269): ", round(ostit$utl,2)),
          tags$li("Stichprobengröße: ", ostit$sample_size),
          tags$li("Anzahl Produkte innerhalb Spezifikation: ", ostit$nr_io_items)
        )
      ),
      tags$b(HTML("Erfüllt ein Prozess mit den geschätzten Parametern<br/>
                  (d.h. Prozess-Mittelwert = Stichproben-Mittelwert und <br/>
                  Prozess-Variabilität = Stichproben-Variabilität) <br/>
                  die Anforderung bzg. minimaler i.o.-Rate?<br/>")),
      tags$b(HTML(
        ifelse(ostit$estimated_process_good,
               "Ja. <br/>Die Frage ist mit welcher Wahrscheinlichkeit<br/>
                    der Test zu diesem Ergebnis kommt!",
               "Nein! <br/>Die Frage ist mit welcher Wahrscheinlichkeit<br/>
                    der Test zu diesem Ergebnis kommt!")
        )
      )
    )
  }
})