I have a dataframe that is updated each time the user changes the year, let's call it mydata.
In output, I'd like to have a table with the possibility to select columns to show, but I'd like the "choices" argument (in the checkboxGroupInput) to be different according the year.
Short part of my current code :
Ui :
sliderInput("year","Choose the year",min=2013,max=2018,value=2017,step=1,sep=""),
conditionalPanel(condition="input.year==2013",
checkboxGroupInput("show_vars13", "Choose variables to show:",colnames13,
selected=c(var1,var2))
),
conditionalPanel(condition = "input.year==2014",
checkboxGroupInput("show_vars14","Choose variables to show:",colnames14,
selected=c(c(var1,var2))
),
conditionalPanel(condition="input.year==2015",
checkboxGroupInput("show_vars15","Choose variables to show:",colnames15,
selected=c(var1,var2))
),
conditionalPanel(condition="input.year==2016",
checkboxGroupInput("show_vars16","Choose variables to show:",colnames16,
selected=c(var1,var2))
),
conditionalPanel(condition="input.year==2017",
checkboxGroupInput("show_vars17","Choose variables to show:",colnames17,
selected=c(var1,var2))
),
tableOutput("data")
server :
output$data <- renderTable({
year <- as.numeric(substr(input$year,3,4))
for (i in 13:17){
if (year==i){
show_vars <- get(paste("input$show_vars",i,sep=''))
}
}
return(mydata[, show_vars, drop = FALSE])
})
This code doesn't work. R Shiny returns "object 'input$show_vars17' not found"
Try
show_vars <-input[[paste0("show_vars",i)]]
in
show_vars <- get(paste("input$show_vars",i,sep='')) ,
"input$show_vars" is just a string ..
if you want to refer to the variable, remove quotes, and write :
show_vars <- get(paste(input$show_vars,i,sep=''))
Related
I have a tab of my app where I display a bunch of text inputs based on a three-column data frame that contains: variable_name, text_prompt, and example_data. The code below seems to work fine since it displays how I want it to. Eventually, I will be feeding it different data frames, depending on the circumstances, so I need to be able to do everything programmatically.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
#THIS IS THE PART I DON'T KNOW HOW TO DO
#input.data <- ???
#I'll add dummy data so that the program loads
input.data <- tibble(var.names,
temp = 1:length(var.names))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)
But what I want - and really have no idea how to do - is to get it back into a data frame after the user hits "submit" (I only need two columns in the subsequent data frame; I don't need the text_prompt data again.)
I know that the user input creates a list of read-only ReactiveValues called "input". But I can't figure out how to do anything with this list besides access using known names (i.e. I know that there is a variable named "project_id" which I can access using input$project_id). But what I want is not to have to write them all out, so that I can change the data used to create the input fields. So I need a way to collect them in a data frame without knowing all the individual names of the variables or even how many there are.
I figured this out on my own. You can't index reactive values with []. However, for some reason you can using [[]].
I would love to know why this is, if anyone has an answer that can help me understand why it works this way.
Here's the key bit of code that I was missing before:
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
The full code that works as I want it is pasted below. I'd still appreciate any feedback or recommendations for improvement.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)
I want to create a shiny app, that filters data table with two select inputs, that one of them is multiple and dependent on another one. First select input is category and the second one is brand. Brand is dependent on category input. I already made two dependent select inputs, but when I go to the filtering process of data table I get stuck. Because when I run app and filter data table with dependent multiple select, I get error " Warning in df$C_BRAND == input$brand :
longer object length is not a multiple of shorter object length".
I understand that whe I choose only one value on the second select its good, but when there is more, filtering fales.
runApp(list(
ui = basicPage(
sidebarPanel(
selectInput("kat", "Kategorija", choices = unique(df1$C_CTG), selected = unique(df1$C_CTG)[1]),
tags$hr(),
selectInput("brand", "Brandas", choices = df1$C_BRAND[df1$C_CTG == unique(df1$C_CTG)[1]],
multiple = TRUE)
),
mainPanel(
DT::dataTableOutput("table")
)
),
server = function(input, output, session) {
observe({
kat <- input$kat
updateSelectInput(session, "brand", choices = df1$C_BRAND[df1$C_CTG == kat])
})
df <- main2019
filterData1 <- reactive({
df[which(df$C_CTG == input$kat & df$C_BRAND == input$brand),]
})
output$table <- DT::renderDataTable({
DT::datatable(filterData1(),selection="multiple",rownames = F)
})
}
))
I know that I have to change this code line
df[which(df$C_CTG == input$kat & df$C_BRAND == input$brand),]
But I dont know what to put there, that when I choose more options in select input, filtering would work.
Here I made simple small sample of my datatable:
C_CTG <- sample(c(1:5),8,replace=TRUE)
brand <- sample(c(6:10),8,replace=TRUE)
store <- sample(c("shoes", "phones", "food", "drinks", "pets"),8, replace = TRUE)
input <- data.frame(C_CTG,brand,store)
Here is example of my generated data table
I expect for example, that in my first select I would choose value "2" in input$C_CTG and then in second select input$brand I would get to choose from "7" or "10" values and depending on what I will choose (7 or 10 or both) data table would show one row where input$C_CTG=2 and input$brand=10 or two rows where input$C_CTG=2 and input$brand=7 or it could show 3 rows when I chose input$C_CTG=2 and input$brand=c(7,10)
I hope that this example will let you understand what I want to make.
I have a simple shiny app with 2 datables.
#ui.r
navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
),
mainPanel(
DT::dataTableOutput("hot3"),
br(),
DT::dataTableOutput("hot5")
)
)))
#server.r
library(shiny)
library(DT)
server <- function(input, output,session) {
DF= data.frame(Sel. = rep(TRUE,2),
Label=paste("Test",as.integer(1:2)),
Marg=rep("Marg1",2),
Avail.=as.integer(rep.int(50,2)),
Sel =as.integer(rep.int(50,2)),
stringsAsFactors = FALSE)
output$hot3 <-DT::renderDataTable(
DF,
selection=list(mode="single", target="cell")
)
output$hot5 <-DT::renderDataTable({
DF = data.frame(
Sel= rep(TRUE, as.numeric(input$hot3_cells_selected)),
Id= 1:as.numeric(input$hot3_cells_selected),
Label=paste("Item",as.integer(1:as.numeric(input$hot3_cells_selected))),
Pf=as.integer(rep.int(0,as.numeric(input$hot3_cells_selected))),
stringsAsFactors = FALSE)
DF
})
}
What I want to achieve is when I click on the "Avail" cell (50) to create a new data frame with 50 rpws which will be displayed in a new data table.
but I take as error
Error in rep: invalid 'times' argument
This error is thrown by the rep function since you don't provide a valid times argument. In this case, input$hot3_cells_selected returns a vector representing the row and column indices of the selected cell, respectively. You can access the actual content of the cell using:
DF[input$hot3_cells_selected]
However, you need some additional adjustments to make your code more robust. For example, input$hot3_cells_selected is empty until a cell is selected, which will cause a similar problem with the rep function. Or, your should cover the case where a non-numeric cell is selected (i.e Test1 or Marg1). Below is a possible naïve solution:
# changing only this part of the code will be enough
# inserted DF[input$hot3_cells_selected] when needed below
output$hot5 <-DT::renderDataTable({
# checking whether any cell is selected or not
if(length(input$hot3_cells_selected) > 0) {
# checking whether the selected cell includes a number or not
# note that suppressWarnings is optional
if(!is.na(suppressWarnings(as.numeric(DF[input$hot3_cells_selected])))) {
# you don't need to store the data frame, so removed the assignment
# even if you wanna store it for future reference, use a unique name (not DF)
data.frame(
Sel= rep(TRUE, as.numeric(DF[input$hot3_cells_selected])),
Id= 1:as.numeric(DF[input$hot3_cells_selected]),
Label=paste("Item",as.integer(1:as.numeric(DF[input$hot3_cells_selected]))),
Pf=as.integer(rep.int(0,as.numeric(DF[input$hot3_cells_selected]))),
stringsAsFactors = FALSE
)
}
}
})
The objective of the application is for the user to select some variables from the selectinput function in rshiny and based on whatever variables are selected there should be a corresponding numericinput box which takes the weightage of that variable as input.
So for example if I select four variable from the selectinput function then there should be 4 numericinput boxes which would prompt the user to enter the corresponding weightages.
I am able to do this using the checkbox option instead of selectinput function, but since the number of variables are huge checkbox option is not viable.
Using checkbox function the codes is as follows:
checkboxInput("pick", "Picked_up"),
conditionalPanel(
condition = "input.pick == true",
numericInput("var1","Enter the weightage of the variable","")
),
br(),
checkboxInput("c2", "%C2"),
conditionalPanel(
condition = "input.c2 == true",
numericInput("var2","Enter the weightage of the variable","")
),
br(),
checkboxInput("newfill", "Perc_Newfill"),
conditionalPanel(
condition = "input.newfill == true",
numericInput("var3","Enter the weightage of the variable","")
),
br(),
checkboxInput("rts", "%RTS"),
conditionalPanel(
condition = "input.rts == true",
numericInput("var4","Enter the weightage of the variable","")
)
I want to implement the same functionality for selectinput function, the code I tried is as follows:
ui.r
uiOutput('select_value'),
uiOutput('input_value'),
server.r
output$select_value <- renderUI({
selectInput('var_name','choose variables',names(descriptive_data),multiple = TRUE)
})
runInput2<- observeEvent(input$var_name,{
for(i in 1:length(input$var_name))
{
output$input_value <- renderUI({
mydata <- input$var_name[1]
numericInput('var', 'input weightage',"")
})
}
})
I am new to Rshiny and hence would be open to inputs suggestions as to what I am doing wrong and how can i implement this.
Here is a solution for your problem. It creates a numericInput for each variable selected. Instead of using a for loop, it uses a lapply function which return a list with all the UI elements created (this is the best way to group multiple UI elements). Finally, to avoid create multiple observers to get the values of the numericInput's, it uses an action button to recover the values only if the variable was selected. At the beginning of the server function, a vector was created to store the predefined weight values, it also is useful to restore the value of a numericInput previously assigned by the user. This is necessary because every time a new variable is selected, the full mainPanel is rendered again.
library(shiny)
ui <- fluidPage(
sidebarPanel(uiOutput('select_value')),
mainPanel(uiOutput('input_value'))
)
server <- function(input , output){
descriptive_data <- mtcars
# initial value for weights and to keep track of value
weightages <- rep(0, ncol(descriptive_data))
# set names to simplify recover/storing value
names(weightages) <- names(descriptive_data)
output$select_value <- renderUI({
div(
selectInput('var_name', 'choose variables',
names(descriptive_data), multiple = TRUE),
actionButton("get", "Get weightages"),
tableOutput('table')
)
})
output$input_value <- renderUI({
var_name <- input$var_name
if (!is.null(var_name)) {
# lapply will return a list
lapply(1:length(var_name), function(k) {
numericInput(paste0("var", k),
paste('input weightage for',
# assign stored value
var_name[k]), weightages[[var_name[k]]])
})
}
})
observeEvent(input$get, {
# to avoid create one observer per numeric input
# we use a action button to trigger the recovering
# of weights.
var_name <- input$var_name
if (!is.null(var_name)) {
for(k in 1:length(var_name)) {
# only recover/update value is the numeric input exists
if (!is.null(input[[paste0("var", k)]]))
weightages[[var_name[k]]] <<- input[[paste0("var", k)]]
}
}
# show current weights
output$table <- renderTable(data.frame(
variable = names(descriptive_data),
weightages))
})
}
shinyApp(ui = ui , server = server)
I have a series of inputs in my R Shiny app that I am using as arguments to a function to select specific data from a data frame. On of the inputs is dateInput:
dateInput("dateSelect", "Date", format = "yyyy-mm-dd", value = NA)
In my function, I need to specify if dateSelect is blank or not selected, to be able select All dates. See an example that is working correctly, that isn't a date, and a simple selectInput:
selectInput("teamSelect", "Team", choices = c("All", levels(newEffortstable$team)))
In the function, this works to select 'All teams':
if(!missing(teamSelect)){
if(teamSelect!="All"){
selections[["teamEfforts"]] =
newEffortstable$effortNo[which(newEffortstable$team %in% teamSelect)]
}else{
selections[["teamEfforts"]] = newEffortstable$effortNo
}
}
I have tried the following with NA and NULL and " " and keep getting 'Error in if: argument is of length zero'
if(!missing(dateSelect)){
if(!dateSelect== "NA"){
selections[["dateEfforts"]] =
newEffortstable$effortNo[which(newEffortstable$date == dateSelect)]
}else{
selections[["dateEfforts"]] = newEffortstable$effortNo
}
}
Thanks!
There's one option you didn't try out yet: checking the length. When no date is given, dateInput returns an empty Date vector as illustrated in the example below.
So you could check if(length(input$dateSelect) == 0), but this is not the most solid shiny option. In order to avoid that you have to check all possibilities (i.e. NULL, NA, "", numeric(0) etc), you can use the function isTruthy() as in the example below:
shinyApp(
ui = fluidPage(
dateInput("dateSelect","Date"),
verbatimTextOutput("out"),
textOutput("text")
),
server = function(input,output,session){
output$text <- renderText({
if(!isTruthy(input$dateSelect)){
"NO DATE"
} else {
paste("The chosen date is:",input$dateSelect)
}
})
output$out<- renderPrint({str(input$dateSelect)})
}
)