R shiny: get all Factors after input Data - r

Hey I have a Shiny App which input Data and work with them. But now I want an actionbutton which select the Factors for a subset funktion. Problem is that when I start the App and input the Data, the Factors are not there, just after the first click on the action button the factors get the column names of the Data.
How can I program this so that the factors are displayed to me directly after reading the data. Thank you for your help!
Here a part of the UI and Server
radioButtons(
"fileType_Input",
label = h5("Choose file type and click on browse"),
choices = list(".csv" = 1, ".xlsx" = 2),
selected = 1,
inline = TRUE
),
fileInput('file1', '' ),
selectInput("letters", label=NULL, factors, multiple = TRUE),
actionButton("choose", "Auswahl"),
verbatimTextOutput("list")
Server:
shinyServer(function(input, output, session) {
# Get the upload file
myData <- reactive({
inFile <- input$file1
if (is.null(inFile)) {
return(NULL) }
if (input$fileType_Input == "1") {
read.csv2(inFile$datapath,
header = TRUE,
stringsAsFactors = FALSE)
} else {
read_excel(inFile$datapath)
}
})
# When the Choose button is clicked, add the current letters to v$choices
# and update the selector
observeEvent(input$choose, {
data <- myData()
factors <- colnames(data) # get the names of the Factors in a Vector to select them
v$choices <- input$letters # append(v$choices,input$letters)
updateSelectInput(session, "letters",
choices = factors #[!factors %in% v$choices)]
)
})
output$list <- renderPrint({
v$choices
})

Instead of putting your code in observeEvent for input$choose you could put it in observe. Something like this:
observe({
if(!is.null(myData()))
{
data <- myData()
factors <- colnames(data) # get the names of the Factors in a Vector to select them
v$choices <- input$letters # append(v$choices,input$letters)
updateSelectInput(session, "letters",
choices = factors #[!factors %in% v$choices)]
)
}
})
Hope it helps!

Related

Shiny app. breaks down after trying to process an imported csv file

I have a functional shiny app which breaks down when I try to import my dataframe as csv instead of creating it inside the app. I have the code that does not work commented out.
The data :
DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
transmission=factor(rep(c("automatic","manual"),5)))
the csv:
write.csv(DF2,"C:/Users/User/Documents/Test//cars2.csv", row.names = FALSE)
the error:
Warning: Error in get_col_types: Unsupported object type: NULL Can't extract column types.
and the app:
#ui.r
library(shiny)
library(rhandsontable)
ui <- fluidPage(
titlePanel("RHandsontable"),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
actionButton("sr","Search")
),
mainPanel(
rHandsontableOutput("test")
)
)
)
#server.r
library(shiny)
library(rhandsontable)
server <- function(input, output) {
# Assigning blank values to reactive variable as all the values need to be listed first
values <- reactiveValues(postcode = "",cargroup = "",date="",days="",transmission="",driver_age="",tabledata = data.frame())
d<-reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
DF<- read.csv(inFile$datapath,stringsAsFactors = T)
for(i in 1:ncol(DF)){
DF[,i]<-as.factor(DF[,i])
}
DF
})
observeEvent(values$postcode,{
DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
transmission=factor(rep(c("automatic","manual"),5)))
# When the user selects any value from the dropdown, filter the table and update the value of reactive df
if(values$postcode!=""){
values$tabledata <- d()[ which(d()$agency_postcode ==values$postcode), ]
}else{
# When the postcode value is blank, meaning the user hasn't selected any, the table
# will render without the third column
values$tabledata <- d()[,-3]
}
})
observeEvent(values$cargroup,{
DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
transmission=factor(rep(c("automatic","manual"),5)))
values$tabledata <- d()
# When the user selects any value from the dropdown, filter the table and update the value of reactive df
if(values$cargroup!=""){
values$tabledata <- d()[ which(d()$car_group ==values$cargroup), ]
}else{
# When the cargroup value is blank, meaning the user hasn't selected any, the table
# will render without the third column
values$tabledata <- d()[,-3]
}
})
# Observer for changes made to the hot
observeEvent(input$sr,{
col <- input$test$changes$changes[[1]][[2]]
# Changes made in first column
if(col==0){
values$postcode <- input$test$changes$changes[[1]][[4]]
}
# Changes made in second column
if(col==1){
values$cargroup <- input$test$changes$changes[[1]][[4]]
}
})
# Render the hot object
output$test <- renderRHandsontable({
rhandsontable(values$tabledata[1,], rowHeaders = NULL, width = 550, height = 300)%>%
hot_col(colnames(values$tabledata))
})
}
***EDIT BASED ON NULL (2)
output$test <- renderUI({
if (is.null(input$file1)){
return("Add file")
}
else{
rhandsontable(values$tabledata[1,], rowHeaders = NULL, width = 550, height = 300)%>%
hot_col(colnames(values$tabledata))
}
})
I have used the code from the answer I provided here, updated it to include .csv uploads. Hope this helps.
Snippet for creating df and saving .csv
test <- data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
transmission=factor(rep(c("automatic","manual"),5)))
write.csv(test,paste0("C:/Users/",Sys.getenv("USERNAME"),"/Desktop/Sample.csv"))
For your shiny app, the ui part can be the same. Below is the updated server code.
server <- function(input, output) {
# Assigning blank values to reactive variable as all the values need to be listed first
values <- reactiveValues(postcode = "",cargroup = "",tabledata = data.frame(), sourcedata = data.frame())
# Let's add another reactive df called sourcedata. This will have our parent data
# The dataframe table data will be the parsed data passed to create handsontable object
values$sourcedata <- data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
transmission=factor(rep(c("automatic","manual"),5)))
observe({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
sourceData <- read.csv(inFile$datapath,stringsAsFactors = TRUE)
sourceData$agency_postcode <- as.factor(sourceData$agency_postcode)
sourceData$car_group <- as.factor(sourceData$car_group)
sourceData$transmission <- as.factor(sourceData$transmission)
# if any .csv files are uploaded, update the value of sourceData from the hardcoded dataframe
values$sourcedata <- sourceData
values$tabledata <- sourceData[,-3]
}
)
observeEvent(values$postcode,{
DF2 = values$sourcedata
# When the user selects any value from the dropdown, filter the table and update the value of reactive df
if(values$postcode!=""){
values$tabledata <- DF2[ which(DF2$agency_postcode ==values$postcode), ]
}else{
# When the postcode value is blank, meaning the user hasn't selected any, the table
# will render without the third column
values$tabledata <- DF2[,-3]
}
})
observeEvent(values$cargroup,{
DF2 = values$sourcedata
# When the user selects any value from the dropdown, filter the table and update the value of reactive df
if(values$cargroup!=""){
values$tabledata <- DF2[ which(DF2$car_group ==values$cargroup), ]
}else{
# When the cargroup value is blank, meaning the user hasn't selected any, the table
# will render without the third column
values$tabledata <- DF2[,-3]
}
})
# Observer for changes made to the hot
observeEvent(input$test$changes$changes,{
col <- input$test$changes$changes[[1]][[2]]
# Changes made in first column
if(col==0){
values$postcode <- input$test$changes$changes[[1]][[4]]
}
# Changes made in second column
if(col==1){
values$cargroup <- input$test$changes$changes[[1]][[4]]
}
})
# Render the hot object
output$test <- renderRHandsontable({
rhandsontable(values$tabledata[1,], rowHeaders = NULL, width = 550, height = 300)%>%
hot_col(colnames(values$tabledata))
})
}
Hope this helps.

R shiny puzzling warning: Input to asJSON(keep_vec_names=TRUE) is a named vector

I have written a shiny app that permits the user to amend individual rows of a dataframe but when I try to include an option to append new rows I get this warning on the console:
Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.
and in a text input box that should contain an item from one column of the data frame the following appears instead:
[object Object]
There are a few answers here that refer to the warning message but in different conditions than apply in my case, and they appear to have little in common with each other apart from the warning message.
Here is my app for amending the dataframe. It works perfectly.
require(shiny)
in.df <- data.frame(name = c("Alice","Bob","Charles"),
age = c(22, 25, 36))
rownames(in.df) <- NULL
runApp(
list(
ui = fluidPage(
sidebarPanel(
numericInput("line", "Line number", value = 1),
textInput("name", "Name:"),
numericInput("age", "Age:", value = 25),
actionButton("amendButton", "Amend an entry")
),
mainPanel(
tableOutput("table"))
),
server = function(input, output, session){
values <- reactiveValues()
values$df <- in.df
current_line <- reactive({
il <- input$line
nr <- nrow(values$df)
if(il > nr){
return(nr)
} else if(il <= 0){
return(1)
} else{
return(il)
}
})
amendData <- observe({
if(input$amendButton > 0){
newLine <- isolate(c(input$name, input$age))
values$df <- isolate(values$df[- current_line(), ])
isolate(values$df <- rbind(as.matrix(values$df), unlist(newLine)))
values$df <- values$df[order(values$df[,1]),]
}
})
observe({
updateTextInput(session = session,
inputId = 'name',
value = values$df[unlist( current_line()),1]
)
updateNumericInput(session = session,
inputId = 'age',
value = values$df[unlist( current_line()),2]
)
updateNumericInput(session = session ,
inputId = 'line',
value = current_line()
)
})
output$table <- renderTable(values$df )
}
)
)
It seemed to me that it would be a simple matter to add an 'append' option in the following way:
Add a new action button
actionButton("appendButton", "Append an entry")
Include a corresponding handler that can be very similar indeed to the handler for the addButton:
addData <- observe({
if(input$appendButton > 0){
newLine <- isolate(c(input$name, input$age))
isolate(values$df <- rbind(as.matrix(values$df), unlist(newLine)))
values$df <- values$df[order(values$df[,1]),]
}
})
The only difference of substance between the two handlers is that the new one does not need the line
values$df <- isolate(values$df[- current_line(), ])
because in the append case no old row is being removed.
But it does not work: I get the warning and the odd change to the text input box that I described.
In shiny 1.6 I got a running app after I changed amendData <- observe to amendData <- observeEvent. Otherwise the code got stuck in an infinite loop.
However, in order to be able to add new rows I had to change reactive value current_line. The code always resets it to an existing row so that one can never add new entries.
I had changed current_line so that it also allowed it to be nrow + 1 and cleared the numeric input fields when current_line was larger than the number of rows.
Now, I finally saw the situation that was described in the question.
It was caused by values$df <- rbind(as.matrix(values$df), unlist(newLine)). R added the new row with a name. The named rows of the data frame seemed to be the problem when sent to the UI. My guess is that this is a problem deeply buried in the reactive messaging system of Shiny.
require(shiny)
in.df <- data.frame(name = c("Alice","Bob","Charles"),
age = c(22L, 25L, 36L))
rownames(in.df) <- NULL
runApp(
list(
ui = fluidPage(
sidebarPanel(
numericInput("line", "Line number", value = 1),
textInput("name", "Name:"),
numericInput("age", "Age:", value = 25),
actionButton("amendButton", "Amend an entry")
),
mainPanel(
tableOutput("table"))
),
server = function(input, output, session){
values <- reactiveValues()
values$df <- in.df
current_line <- reactive({
il <- req(input$line)
nr <- nrow(values$df)
if(il > nr){
return(nr+1)
} else if (il <= 0){
return(1)
} else {
return(il)
}
})
amendData <- observeEvent(input$amendButton, {
isolate({
newLine <- c(input$name, as.numeric(input$age))
values$df <- values$df[- current_line(), ]
values$df <- rbind(values$df, unname(newLine))
})
values$df <- values$df[order(values$df[,1]),]
})
observe({
updateNumericInput(session = session, inputId = 'line',
value = current_line())
if (current_line() <= nrow(values$df)) {
updateNumericInput(session = session, inputId = 'age',
value = values$df[current_line(), 2])
updateTextInput(session = session, inputId = 'name',
value = values$df[current_line(), 1])
}
else {
updateNumericInput(session = session, inputId = 'age', value = "")
updateNumericInput(session = session, inputId = 'name', value = "")
}
})
output$table <- renderTable( values$df )
}
)
)

Select and scale variables in shiny app dynamically

I have a shiny app where I want the user to be able to select which variables to keep in the final data frame and then also select which variables to scale into a percent. I have this working, but I am running into a little puzzle. The problem is if the user decides they want to add an additional variable (or remove one), they have to redo the scaling. This could be a problem if my users have many columns they are working on. How can I keep the scaling work the user has already done, while allowing for the addition or removal of variables from the final data frame?
library(shiny)
library(tidyverse)
library(DT)
# Define UI
ui <- fluidPage(
checkboxGroupInput("select_var", label = "Select Variables"),
selectInput("scalescore", label = NULL, choices = c("")),
actionButton("scale", "Scale Scores"),
DT::dataTableOutput("table")
)
# Define server
server <- function(session, input, output) {
# define the reactive values
values <- reactiveValues(df_final = NULL)
# dynamically generate the variable names
observe({
vchoices <- names(mtcars)
updateCheckboxGroupInput(session, "select_var", choices = vchoices)
})
# dynamically generate the variables to scale
observe({
vchoices <- names(values$df_final)
updateSelectInput(session, "scalescore", choices = vchoices)
})
# select the variables based on checkbox
observe({
req(input$select_var)
df_sel <- mtcars %>% select(input$select_var)
values$df_final <- df_sel
})
observeEvent(input$scale, {
name <- rlang::sym(paste0(input$scalescore, "_scaled"))
values$df_final <- values$df_final %>% mutate(!!name := round(!!rlang::sym(input$scalescore)/max(!!rlang::sym(input$scalescore), na.rm = TRUE)*100, 1))})
output$table <- DT::renderDataTable(values$df_final)
}
# Run the application
shinyApp(ui = ui, server = server)
We will need to maintain a vector which tracks whether a variable was scaled or not. Here is how it's done,
library(shiny)
library(tidyverse)
library(DT)
# Define UI
ui <- fluidPage(
checkboxGroupInput("select_var", label = "Select Variables"),
selectInput("scalescore", label = NULL, choices = c("")),
actionButton("scale", "Scale Scores"),
DT::dataTableOutput("table")
)
server = function(input,output,session){
#Column names are static
names = colnames(mtcars)
# data scructure to store if the variable is scaled
is_scaled = logical(length(names))
names(is_scaled) = names #Set the names of the logical vector to the column names
#Update the checkbox with the column names of the dataframe
observe({
updateCheckboxGroupInput(session, "select_var", choices = names)
})
# Update the list of choices but dont include the scaled vaiables
observe({
vchoices <- names(data())
vchoices = vchoices[vchoices %in% names]
updateSelectInput(session, "scalescore", choices = vchoices)
})
#When the scle button is pressed, the vector which contains the list of scaled variables is updated
observeEvent(input$scale,{
if(is_scaled[[input$scalescore]]){
is_scaled[[input$scalescore]] <<- FALSE
}else{
is_scaled[[input$scalescore]] <<- TRUE
}
})
#Function to scale the variables
scale = function(x){
return(round(x/max(x,na.rm = T)*100,1))
}
data = reactive({
req(input$select_var)
input$scale #simply to induce reactivity
#Select the respective columns
df = mtcars%>%
select(input$select_var)
if(any(is_scaled[input$select_var])){
temp_vec = is_scaled[input$select_var] #Get a list of variables selected
true_vec = temp_vec[which(temp_vec)] #Check which ones are scaled
true_vec_names = names(true_vec) #Get the names of the variables scales
#Scale the variables respectively
df = df%>%
mutate_at(.vars = true_vec_names,.funs = funs(scaled = scale(.)))
}
return(df)
})
output$table = DT::renderDataTable(data())
}
# Run the application
shinyApp(ui = ui, server = server)
is_scaled tracks whether a particular column is scaled or not. When it is later selected, it is scaled if the value is TRUE in this vector.
Additional functionality is also added where if the scale button is pressed twice the scale column is removed.

R shiny: save chosen factors from input data

I have a question regarding R shiny and the observ function. Is it possible to save the selected factors and the state of the work? For Example I created a programm which can choose colnames from the input data. After using bookmark and reopening the programm with the link in the browser the input data are loaded but the select factors of the colnames are reset. But I want to save the chosen colnames. Has anyone an idea? Thank you for your help!
ui <- function(request) {
fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(
"fileType_Input",
label = h5(""),
choices = list(".csv" = 1, ".xlsx" = 2),
selected = 1,
inline = TRUE
),
fileInput('file1', '' ),
selectInput("letters", label=NULL, factors, multiple = TRUE),
bookmarkButton()
),
mainPanel(
tableOutput("contents")
)
)
)
}
server <- function(input, output,session) {
myData <- reactive({
inFile <- input$file1
# Get the upload file
if (is.null(inFile)) {
return(NULL) }
if (input$fileType_Input == "1") {
read.csv2(inFile$datapath,
header = TRUE,
stringsAsFactors = FALSE)
} else {
read_excel(inFile$datapath)
}
})
observe({
if(is.null(input$letters)){
data <- myData()
if(is.null(data)){
}else{
factors <- colnames(data)
t$choices <- input$letters # append(u$choices,input$letters2)
updateSelectInput(session, "letters",
choices = factors #[!factors2 %in% u$choices)]
)}
}
})
#Display all input Data
output$contents <- renderTable(digits = NULL,{
df <-myData()
df
})
}
enableBookmarking("server")
shinyApp(ui, server)
You can save all needed inputs in a file, and then reapply them with functions like updateRadioButtons() and others.
Saving it to the file could look like this:
observeEvent(input$someRadioButton, {
states <- list()
states$someRadioButton <- input$someRadioButton
#you can save all the needed inputs like this
...
save(states, file = paste0(getwd(), "/myfile"))
})

isolate function with reactive object base on dplyr shiny

I created a simple shiny app. The goal is to create a histogram with options to manipulate the plot for each dataset. The problem is that when I change a dataset application first show me empty plot and then present a correct plot. To understand the problem I add renderText which show me a number of rows in getDataParams dataset. It seems to me that isolate function should be a solution but I tried several configurations, apparently I still do not understand this function.
library(lazyeval)
library(dplyr)
library(shiny)
library(ggplot2)
data(iris)
data(diamonds)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('', 'iris', 'diamonds')),
uiOutput('server_cols'),
uiOutput("server_cols_fact"),
uiOutput("server_params")
),
column(9,
plotOutput("plot"),
textOutput('text')
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data, diamonds = diamonds, iris = iris)
})
output$server_cols <- renderUI({
validate(need(input$data != "", "Firstly select a dataset."))
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_cols_fact <- renderUI({
req(input$data)
data <- data(); nam <- colnames(data)
selectizeInput('cols_fact', "Choose a fill columns:",
choices = nam[sapply(data, function(x) is.factor(x))])
})
output$server_params <- renderUI({
req(input$cols_fact)
data <- isolate(data()); col_nam <- input$cols_fact
params_vec <- unique(as.character(data[[col_nam]]))
selectizeInput('params', "Choose arguments of fill columns:", choices = params_vec,
selected = params_vec, multiple = TRUE)
})
getDataParams <- reactive({
df <- isolate(data())
factor_col <- input$cols_fact
col_diverse <- eval(factor_col)
criteria <- interp(~col_diverse %in% input$params, col_diverse = as.name(col_diverse))
df <- df %>%
filter_(criteria) %>%
mutate_each_(funs(factor), factor_col)
})
output$text <- renderText({
if(!is.null(input$cols)) {
print(nrow(getDataParams()))
}
})
output$plot <- renderPlot({
if (!is.null(input$cols)) {
var <- eval(input$cols)
print('1')
diversifyData <- getDataParams()
factor_col <- input$cols_fact
print('2')
plot <- ggplot(diversifyData, aes_string(var, fill = diversifyData[[factor_col]])) +
geom_histogram(color = 'white', binwidth = 1)
print('3')
}
plot
})
}
shinyApp(ui, server)
Here is an answer that features quite minimal changes and gives probably some deeper insights into how to control reactivity in future projects.
Your program logic features some decisions of the kind "do A if B, but not if C". But it approaches them brutally, by repeating "do A if B" until finally "not C" is true. To be more precise: You want your getDataParams to be renewed (action A) if input$cols changes (action B), but it throws errors if input$params has not changed yet (condition C).
Okay, now to the fix: We use a feature of observeEvent to evaluate if getDataParams should be recalculated. Lets read (source):
Both observeEvent and eventReactive take an ignoreNULL parameter that
affects behavior when the eventExpr evaluates to NULL (or in the
special case of an actionButton, 0). In these cases, if ignoreNULL is
TRUE, then an observeEvent will not execute and an eventReactive will
raise a silent validation error.
So the change is basically one command. Change
getDataParams <- reactive({ ... })
to
getDataParams <- eventReactive({
if(is.null(input$params) || !(input$cols_fact %in% colnames(data()))){
NULL
}else{
if(all(input$params %in% data()[[input$cols_fact]])){
1
}else{
NULL
}
}, { ... }, ignoreNULL = TRUE)
Here we check if input$cols_fact is a valid column name and if input$params has already been assigned and if so, we check if input$params is a valid list of factors for the given column. This feature was mainly designed, I suppose, to check if some element exists (input$something returning NULL if it's not defined), but we abuse it for logic evaluation and return NULL in one case and 1 (or something not NULL) in the other.
In contrast to logical tests inside the reactive environment, getDataReactive won't be changed or won't trigger change events at all, if the condition is not met.
Note: This is the minimal solution I found. With this tool and/or other changes, the code can still be fairly improved.
Full Code below.
Greetings!
library(lazyeval)
library(dplyr)
library(shiny)
library(ggplot2)
data(iris)
data(diamonds)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('', 'iris', 'diamonds')),
uiOutput('server_cols'),
uiOutput("server_cols_fact"),
uiOutput("server_params")
),
column(9,
plotOutput("plot"),
textOutput('text')
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data, diamonds = diamonds, iris = iris)
})
output$server_cols <- renderUI({
validate(need(input$data != "", "Firstly select a dataset."))
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_cols_fact <- renderUI({
req(input$data)
data <- data(); nam <- colnames(data)
selectizeInput('cols_fact', "Choose a fill columns:",
choices = nam[sapply(data, function(x) is.factor(x))])
})
output$server_params <- renderUI({
req(input$cols_fact)
data <- isolate(data()); col_nam <- input$cols_fact
params_vec <- unique(as.character(data[[col_nam]]))
selectizeInput('params', "Choose arguments of fill columns:", choices = params_vec,
selected = params_vec, multiple = TRUE)
})
getDataParams <- eventReactive({
if(is.null(input$params) || !(input$cols_fact %in% colnames(data()))){
NULL
}else{
if(all(input$params %in% data()[[input$cols_fact]])){
1
}else{
NULL
}
}, {
df <- isolate(data())
factor_col <- input$cols_fact
col_diverse <- eval(factor_col)
criteria <- interp(~col_diverse %in% input$params, col_diverse = as.name(col_diverse))
df <- df %>%
filter_(criteria) %>%
mutate_each_(funs(factor), factor_col)
}, ignoreNULL = TRUE)
output$text <- renderText({
if(!is.null(input$cols)) {
print(nrow(getDataParams()))
}
})
output$plot <- renderPlot({
if (!is.null(input$cols)) {
var <- eval(input$cols)
print('1')
diversifyData <- getDataParams()
factor_col <- input$cols_fact
print('2')
plot <- ggplot(diversifyData, aes_string(var, fill = diversifyData[[factor_col]])) +
geom_histogram(color = 'white', binwidth = 1)
print('3')
}
plot
})
}
shinyApp(ui, server)
To best explaining the flow - I create a picture that explain how the plot get refresh as below:
So, with no isolate code, you will any change in any change on any control on the code will trigger the change to the control on the end of arrow. In this case which end up result the plot refresh 5 times.
With the isolate code in your code from above post, you already eliminate two small arrow.
To avoid the case you mentioned with when Choose a fill columns, you need to eliminate the big arrow that I highlighted by isolate the input$cols_fact in output$plot <- renderPlot{...} reactive.
With this you still have the plot refresh two time when choose data table but I think it acceptable as you need the plot to re-active when you do Choose numeric columns
Hope this answer your questions! Having fun playing arround with Shiny!

Resources