Interaktive Datenverifizierung mit Shiny o.ä.

[pfischer]

Hallo Edi,
tut mir leid, ich habe nicht wirklich nachgedacht. Du hast natürlich recht, ich sollte das ganze Script natürlich auf den minimalen Kern reduzieren, der das Problem zeigt. Das habe ich nun gemacht, d.h. ich habe nun nur die Abschnitte dringelassen, die erforderlich sind.

Es gibt nun eine Server Abschnitt

observeEvent(input$submit_probably_bad, {}

in dem (so denke ich zumindest) das Problem liegt und es gibt eine Abschnitt

observeEvent(input$save_and_exit, {} der die Daten aus observeEvent(input$submit_probably_bad, {} wieder als file wegschreibt.

Ich hoffe nun wird es klarer und nachvollziehbarer, und auch die assignements ins global.environment habe ich raus:-).

Nochmals Danke für die Nachsicht und die Nachhilfe im richtig Fragen stellen ...

VG Philipp

Code: Alles auswählen

if (!require("shiny")) install.packages("shiny")
library(shiny)
if (!require("plotly")) install.packages("plotly")
library(plotly)
if (!require("DT")) install.packages("DT")
library(DT)
if (!require("R.filesets")) install.packages("R.filesets")
library(R.filesets)
if (!require("shinyBS")) install.packages("shinyBS")
library(shinyBS)
if (!require("plotly")) install.packages("plotly")
library(plotly)

setwd("~")
selected_data <- readRDS("~/R/stat_res_outlier.Rds")

selected_data$flag_value <- ifelse(is.na(selected_data$flag_value),1,selected_data$flag_value)
selected_data$flag_level = 15
selected_data$comment = NA
selected_data$datetime <- as.POSIXct(selected_data$datetime, format = "%Y-%m-%d %H:%M:%S")
selected_data <- selected_data[order(selected_data$datetime),]
selected_data$flag_value <- as.integer(selected_data$flag_value)

subset_data <- selected_data[which(!is.na(selected_data$parameter_value_stud_filter)), ]

ui <- fluidPage(
    plotlyOutput("plot"),
    actionButton("submit_probably_bad", "Flag selection as 'probably bad (level 3)'"),
    actionButton('save_and_exit',"Exit visual data verification and proceed"),
    DT::dataTableOutput("table")
)

server <- function(input, output, session) {
    data <- subset_data
    data$datetime <- as.POSIXct(data$datetime)
    data$id = rownames(subset_data)
    rv <- reactiveValues(data = data)

    observeEvent(input$submit_probably_bad, {
      lasso <- event_data("plotly_selected")
      box <- event_data("plotly_selected")

      if (!is.null(lasso) | !is.null(box) ) {
        tmp <- rv$data[which(rv$data$id %in% lasso$key | rv$data$id %in% box$key), ]
        flag_from <<- min(tmp$datetime)
        flag_to <<- max(tmp$datetime)

        rv$data$flag_value <- ifelse(strftime(rv$data$datetime, format="%Y-%m-%d %H:%M:%S") >= flag_from & strftime(rv$data$datetime ,format="%Y-%m-%d %H:%M:%S") <=  flag_to, 3, rv$data$flag_value)

        rv$data$comment <- ifelse(strftime(rv$data$datetime, format="%Y-%m-%d %H:%M:%S") >= flag_from & strftime(rv$data$datetime ,format="%Y-%m-%d %H:%M:%S") <=  flag_to, "Selected as 'probably bad' by manual quality check (level 15)", rv$data$comment)

      selected_data$flag_value <<- ifelse(strftime(selected_data$datetime, format="%Y-%m-%d %H:%M:%S") >= flag_from & strftime(selected_data$datetime ,format="%Y-%m-%d %H:%M:%S") <=  flag_to, 3, selected_data$flag_value)

      selected_data$comment <<- ifelse(strftime(selected_data$datetime, format="%Y-%m-%d %H:%M:%S") >= flag_from & strftime(selected_data$datetime ,format="%Y-%m-%d %H:%M:%S") <=  flag_to, "Selected as 'probably bad' by manual quality check (level 15)", selected_data$comment)
      }

      output$plot <- renderPlotly({
        showdata <- rv$data[ which(rv$data$flag_value == 1), ]
        showdata$flag_value <- as.factor(showdata$flag_value)
        plot_title = paste("Data between", flag_from, "to", flag_to," flagged as probable bad (3).")
        p <- ggplot() +
          ggtitle(plot_title) +
          geom_point(data = showdata, aes(x = datetime, y = parameter_value_stud_filter, colour = par_id, key = id), size=0.8) +
          geom_point(na.rm = TRUE) +
          scale_color_brewer(palette = "Set2")

        ggplotly(p) %>%
          layout(dragmode = "lasso"
                 , xaxis = list(
                   rangeslider = list())
                 , hovermode = "x")
      })

    })

    observeEvent(input$save_and_exit, {
         saveRDS(selected_data, "~/R/stat_res_outlier.Rds")
        stopApp()
    })

    output$table <- DT::renderDataTable({
         rv$data[!is.na(rv$data$parameter_value_stud_filter),   ]
     })

    output$plot <- renderPlotly({
       style <- isolate(input$style)
       showdata <- rv$data[ which(rv$data$flag_value >=1 & rv$data$flag_value <=5), ]
       showdata$flag_value <- as.factor(showdata$flag_value)
         p <- ggplot() +
           geom_point(data = showdata, aes(x = datetime, y = parameter_value_stud_filter, colour = par_id, key = id), size=0.8) +
             geom_point(na.rm = TRUE) +
             scale_color_brewer(palette = "Set2")
         ggplotly(p) %>%
             layout(dragmode = "lasso"
                    , xaxis = list(
                        rangeslider = list())
                    , hovermode = "x")
     })
}
shinyApp(ui, server)