Например: я хочу сохранять filter_output для каждого случая if после того, как пользователь нажмет кнопку. Что происходит, если пользователь выбирает Среднее значение для одной строки, данные изменяются, но после этого пользователь выбирает минимальное или среднее значение для другой строки, данные пропадают с первого щелчка. Он снова показывает данные df ().
filtered_output <- df()
===== Событие кнопки ========================
observeEvent(input$confirm_numeric_replace, {
if(input$select_numeric_replace_with == "Average"){
filtered_output <- filtered_output() %>% mutate_at(vars(input$select_numeric_replace_input), ~ifelse(is.na(.x), mean(.x, na.rm = TRUE), .x))
output$filtered_table <- renderDataTable(filtered_output)
}
if(input$select_numeric_replace_with == "Min"){
filtered_output <- filtered_output() %>% mutate_at(vars(input$select_numeric_replace_input), ~ifelse(is.na(.x), min(.x, na.rm = TRUE), .x))
output$filtered_table <- renderDataTable(filtered_output)
}
if(input$select_numeric_replace_with == "Max"){
filtered_output <- filtered_output() %>% mutate_at(vars(input$select_numeric_replace_input), ~ifelse(is.na(.x), max(.x, na.rm = TRUE), .x))
output$filtered_table <- renderDataTable(filtered_output)
}
if(input$select_numeric_replace_with == "0"){
filtered_output <- filtered_output() %>% mutate_at(vars(input$select_numeric_replace_input), ~ifelse(is.na(.x), 0, .x))
output$filtered_table <- renderDataTable(filtered_output)
}
})
Полный код ниже.
library(shinydashboard)
library(fontawesome)
library(thematic)
library(DT)
library(dplyr)
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody()
)
ui <- dashboardPage(
dashboardHeader(dropdownMenu(type = "messages",
messageItem(from = "Sales Dept",
message = "Message from Sales"),
messageItem(from = "New User",
message = "Message from new user",
icon = icon("question"))
),#closing dropdownmenu for message
dropdownMenu(type = "notification",
notificationItem(text = "12 items deliverd",
icon = icon("truck")),
notificationItem(text = "5 new users",
icon = icon("users"))
),#closing Notification drop down
dropdownMenu(type = "tasks", badgeStatus = "success",
taskItem(value = 90, color = "green", "Documentation")
)
),#closing dashboard header
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Cleaning", tabName = "cleaning", icon = icon("th")),
menuItem("Graphs", tabName = "graphs", icon =icon(name = "signal", class = NULL, lib = "font-awesome") ),
menuItem(tabName = "Analysis", "analyse", icon =icon(name = "diagnoses", class = NULL, lib = "font-awesome"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
fileInput("filename", "", accept = c(".csv",".tsv"))
),
fluidRow(
column(12,
dataTableOutput("main_file"))
)
),#Tab Dashboard
# Second tab content
tabItem(tabName = "cleaning",
uiOutput("omitna"),
fluidRow(
column(2,
"Type numeric column name to replace NA with.",
selectInput("select_numeric_replace_input", "Replace NA in the column", c(""))
),
column(3,
tags$br(),tags$br(),
selectInput("select_numeric_replace_with", "Replace NA in column with", c("Average", "Minimun", "Max", "0")))
),
fluidRow(column(2,
actionButton("confirm_numeric_replace","Replace NA"),
uiOutput("button_press")
)
),
fluidRow(
tags$br(),tags$br(),
column(2,
"Type categorical column name to replace NA with.",
selectInput("select_cat_replace_input", "Replace NA in the column with", c(""))
),
column(3,
tags$br(),tags$br(),tags$br(),
textInput("select_cat_replace_with", "Replace NA in column with")),
),
fluidRow(column(2,
actionButton("confirm_cat_replace","Replace NA")
)
),
fluidRow(tags$br(), tags$br(), column(2,
"Convert data type of the Row",
selectInput("label_data_type_replace", "Convert column type", c("Rows"))
),
column(3,
"Convert data type to",
selectInput("select_data_type_replace", "Convert data type of", c("Numeric","Character","Date"))
)
),
fluidRow(column(2,
actionButton("confirm_dt_convert","Convert Data Type"))
),
fluidRow(
tags$br(),
column(12,
dataTableOutput("filtered_table"))
),
fluidRow(
tags$br(),
column(12,
tableOutput("missing_summary"))
)
),#Tabitem Widgets
#Graphs tab content
tabItem(tabName = "graphs",
fluidRow("Graphs")
),#tabitem Graphs
#Tab Analyse
tabItem(tabName = "analyse",
fluidRow(
)#Fluidrow
)#tabitem Analyse
)
)
)
server <- function(input, output, session) {
df <- reactive(pokemon)
#############################DashBoard######
# df <- reactive({
# req(input$filename)
#
# ext <- tools::file_ext(input$filename$name)
# switch (
# ext,
# csv = vroom::vroom(input$filename$datapath, delim = ","),
# tsv = vroom::vroom(input$file$datapath, delim = "\t"),
# validate("Invalid file; Please upload a .csv or .tsv file")
# )
# })
output$main_file <- renderDataTable(df())
#closing Dashboard
#Cleaning######################################
output$omitna <- renderUI(selectInput("omitna","Remove columns which has NA or no data in the file.",c("Don't change","Remove_Columns")))
filtered_output <- reactive(if(input$omitna == "Remove_Columns"){
filtered_output <- (na.omit(df()))
}else {filtered_output <- df()}
)
observe({
num_col <- names(dplyr::select_if(df(), is.numeric))
cat_col <- names(dplyr::select_if(df(), is.character))
updateSelectInput(session, "select_numeric_replace_input", choices = num_col)
updateSelectInput(session, "select_cat_replace_input", choices = cat_col)
})
output$missing_summary <- renderTable({
filtered_output() %>%
mutate_all(is.na)%>%
mutate_all(as.numeric)%>%
summarise_all(sum)
})
observeEvent(input$confirm_numeric_replace, {
if(input$select_numeric_replace_with == "Average"){
#avg <- filtered_output() %>% summarise_at(vars(input$select_numeric_replace_input), mean)
filtered_output <- filtered_output() %>% mutate_at(vars(input$select_numeric_replace_input), ~ifelse(is.na(.x), mean(.x, na.rm = TRUE), .x))
output$filtered_table <- renderDataTable(filtered_output)
}
if(input$select_numeric_replace_with == "Min"){
filtered_output <- filtered_output() %>% mutate_at(vars(input$select_numeric_replace_input), ~ifelse(is.na(.x), min(.x, na.rm = TRUE), .x))
output$filtered_table <- renderDataTable(filtered_output)
}
if(input$select_numeric_replace_with == "Max"){
filtered_output <- filtered_output() %>% mutate_at(vars(input$select_numeric_replace_input), ~ifelse(is.na(.x), max(.x, na.rm = TRUE), .x))
output$filtered_table <- renderDataTable(filtered_output)
}
if(input$select_numeric_replace_with == "0"){
filtered_output <- filtered_output() %>% mutate_at(vars(input$select_numeric_replace_input), ~ifelse(is.na(.x), 0, .x))
output$filtered_table <- renderDataTable(filtered_output)
}
})
output$filtered_table <- renderDataTable(filtered_output())
#Closing Cleaning
}
shinyApp(ui, server)