Reputation: 1722
Recently I asked that I had a problem with pickerInput
. The question was solved, but I was wondering how to do it just having the data in one reactive function without creating another one + two columns which are not numerical.
In this post, I used mtcars inside a reactive function (simulating what I usually do when I upload a file) and then, in another reactive function, I was doing the changes in the dataframe (log and sqrt). However, I wanted to add two non-numerical columns and this must be done after the transformation.
dat <- mtcars
dat$Brands <- rownames(dat)
str(dat$Brands)
> chr [1:32] "Mazda RX4" "Mazda RX4 Wag" "Datsun 710" "Hornet 4 Drive"
> "Hornet Sportabout" "Valiant" "Duster 360" "Merc 240D" ...
dat$Info <- rep("Info", length(rownames(mtcars)))
str(dat$Info)
> chr [1:32] "Info" "Info" "Info" "Info" "Info" "Info" "Info" "Info"
> "Info" "Info" "Info" "Info" "Info" "Info" "Info" "Info" ...
In that post, if I add the two non numerical columns in data1() and I leave pickerInput
with data() as they answered me, the non numerical columns will not appear to select.
For that reason, I put all the information in one single reactive function... However, now the solution doesn't work.
Everytime that I click in one checkboxInput
the selected columns change automatically.
This is the code:
library(shiny)
library(shinyWidgets)
library(dplyr)
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
uiOutput("picker"),
checkboxInput("play", strong("I want to play with my data"), value = FALSE),
conditionalPanel(
condition = "input.play == 1",
checkboxInput("change_log2", "Log2 transformation", value = FALSE),
checkboxInput("run_sqrt", "sqrt option", value = FALSE)),
actionButton("view", "View Selection")
),
# Show a plot of the generated distribution
mainPanel(
h2('Mydata'),
DT::dataTableOutput("table"),
)
)
)
library(shiny)
library(DT)
server <- function(session, input, output) {
data <- reactive({
dat <- mtcars
if(input$change_log2){
dat <- log2(dat)
}
if(input$run_sqrt){
dat <- sqrt(dat)
}
dat$Brands <- rownames(dat)
dat$Info <- rep("Info", length(rownames(mtcars)))
return(dat)
})
observeEvent(input$play, {
if(!input$play) {
updateCheckboxInput(session, "change_log2", value = FALSE)
updateCheckboxInput(session, "run_sqrt", value = FALSE)
}
})
output$picker <- renderUI({
pickerInput(inputId = 'pick',
label = 'Choose',
choices = colnames(data()),
options = list(`actions-box` = TRUE),
multiple = T,
selected = colnames(data())
)
})
datasetInput <- eventReactive(input$view,{
datasetInput <- data() %>%
select(input$pick)
return(datasetInput)
})
output$table <- renderDT({
datatable(
datasetInput(),
filter="top",
rownames = FALSE,
extensions = 'Buttons',
options = list(
dom = 'Blfrtip',
buttons =
list('copy', 'print', list(
extend = 'collection',
buttons = list(
list(extend = 'csv', filename = "File", title = NULL),
list(extend = 'excel', filename = "File", title = NULL)),
text = 'Download'
))
),
class = "display"
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I suppose it has to be something related to updatepickerInput
(I saw similar problems like this but I don't know how to do it in a unique pickerInput
.
Does anyone know how to solve it?
Thanks in advance
Regards
Upvotes: 0
Views: 729
Reputation: 388982
You may use reactiveValues
to save the dataset and apply the function to only numeric columns of the selected columns from pickerInput
.
library(shiny)
library(shinyWidgets)
library(dplyr)
library(DT)
dat <- mtcars
dat$Brands <- rownames(dat)
dat$Info <- rep("Info", length(rownames(mtcars)))
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
uiOutput("picker"),
checkboxInput("play", strong("I want to play with my data"), value = FALSE),
conditionalPanel(
condition = "input.play == 1",
checkboxInput("change_log2", "Log2 transformation", value = FALSE),
checkboxInput("run_sqrt", "sqrt option", value = FALSE)),
actionButton("view", "View Selection")
),
# Show a plot of the generated distribution
mainPanel(
h2('Mydata'),
DT::dataTableOutput("table"),
)
)
)
server <- function(session, input, output) {
rv <- reactiveValues(data = dat)
observeEvent(input$play, {
if(!input$play) {
updateCheckboxInput(session, "change_log2", value = FALSE)
updateCheckboxInput(session, "run_sqrt", value = FALSE)
}
})
output$picker <- renderUI({
cols <- names(rv$data)
pickerInput(inputId = 'pick',
label = 'Choose',
choices = cols,
options = list(`actions-box` = TRUE),
multiple = T,
selected = cols)
})
datasetInput <- eventReactive(input$view,{
datasetInput <- rv$data %>% select(input$pick)
if(input$change_log2){
datasetInput <- datasetInput %>% mutate(across(where(is.numeric), log2))
}
if(input$run_sqrt){
datasetInput <- datasetInput %>% mutate(across(where(is.numeric), sqrt))
}
return(datasetInput)
})
output$table <- renderDT({
datatable(
datasetInput(),
filter="top",
rownames = FALSE,
extensions = 'Buttons',
options = list(
dom = 'Blfrtip',
buttons =
list('copy', 'print', list(
extend = 'collection',
buttons = list(
list(extend = 'csv', filename = "File", title = NULL),
list(extend = 'excel', filename = "File", title = NULL)),
text = 'Download'
))
),
class = "display"
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Upvotes: 1