I want to provide inputselect "choices" in dependency of uploaded files (fileInput). In the example below I want as.list(mydata[1, 1:5]) as values for inputselect choices. Later on the subsetting values will be dynamic and is not showed here.
I tried several approaches suggested in the forum (reactive, observe, reactiveValue and their combination) without much success.
My script runs partially, however I need a page refresh to the get the "choices" uploaded and reload the file again.
server.R
shinyServer(function(input, output, session) {
output$contents <- renderDataTable({
inFile <<- input$SoftRecom
if (is.null(inFile))
return(NULL)
filedatapath <<- reactive({inFile$datapath})
mydata <<- read.csv(filedatapath(), header = TRUE, sep = ',')
mydata
})
mychoices <<- reactive({
mydata
print(mydata)
})
output$vg <- renderUI({
selectInput("vg", label = p("goal", style = "color:#FFA500"),
mychoices()[1,1:5], selected = 1)
})
output$vp <- renderUI({
selectInput("procedure", label = p("procedure", style = "color:#FFA500"),
choices = c("proecudures"), selected = 1)
})
output$vm <- renderUI({
selectInput("procedure", label = p("procedure", style = "color:#FFA500"),
choices = c("ChIP-seq"), selected = 1)
})
})
ui.R
shinyUI(fluidPage(theme = "bootstrap.css",
titlePanel("simple software recommendation sytem"),
sidebarLayout(
sidebarPanel(
fileInput('SoftRecom', 'choose dataset'),
uiOutput("vg"), # variable goal
uiOutput("vp"), # variable procedure
uiOutput("vm") # variable method
),
mainPanel(
dataTableOutput('contents')
)
)
))
I have seen many examples and answers in the forum, that are very close (or even match) my question. Sorry for being so obtuse. If someone could point me to the problem, I would be very thankful.
Jay
Eventually I found the solution by myself. Don't get confused by the different server code in my question and the answer. Just look at the relationship between
uiOutput('pipelinestep') and
output$pconst <<- renderUI({selectizeInput(
'pconst', 'construct software workflow', choices = as.character(mysoft[mysoft$goal==mypipefilter, 3]),
multiple = TRUE, options = list(maxItems = 1))}
UI.R
I had to insert: uiOutput("pipelinestep") see line 8
shinyUI(fluidPage(theme = "bootstrap.css",
titlePanel( h2("simple software recommendation system", style = "color:#FFA500")),
sidebarLayout(position = "left",
sidebarPanel(width =3,
# chose standard pipeline
selectInput("selectpipe", "select standard pipeline:", choices = pipechoices),
# software details
*uiOutput("pipelinestep")*, # software per pipeline step,
# construct software workflow based on selected pipeline step
uiOutput("pconst")
))))
server.R
see from line 5 to 7. "Choices" gets new values assigned as soon a change is detected. Please see documentation here: http://shiny.rstudio.com/articles/dynamic-ui.html
pipelinestepsoftInput <<- reactive({
mypipefilter <- input$pipelinestep
softperpipe <<- mysoft[mysoft$goal==mypipefilter ,c(1,3,5:7), drop = FALSE]
## provides software choices related to the pipeline step
output$pconst <<- renderUI({selectizeInput(
'pconst', 'construct software workflow', choices = as.character(mysoft[mysoft$goal==mypipefilter, 3]),
multiple = TRUE, options = list(maxItems = 1))})
## input for outputDataTable
softperpipe
})
Related
The code below is adapted from https://gist.github.com/wch/4211337 and perfectly illustrates my challenges. I have two main issues:
I cannot get the interactive tables to download; and
I can't figure out how to make the table print with a page length, for example that shows 25 rows and lets you toggle to the next page.
Here is the code:
server.r
data_sets <- c("mtcars", "morley", "rock")
shinyServer(function(input, output) {
# Drop-down selection box for which data set
output$choose_dataset <- renderUI({
selectInput("dataset", "Data set", as.list(data_sets))
})
# Check boxes
output$choose_columns <- renderUI({
# If missing input, return to avoid error later in function
if(is.null(input$dataset))
return()
# Get the data set with the appropriate name
dat <- get(input$dataset)
colnames <- names(dat)
# Create the checkboxes and select them all by default
checkboxGroupInput("columns", "Choose columns",
choices = colnames,
selected = colnames)
})
# Output the data
output$data_table <- renderTable({
# If missing input, return to avoid error later in function
if(is.null(input$dataset))
return()
# Get the data set
dat <- get(input$dataset)
# Make sure columns are correct for data set (when data set changes, the
# columns will initially be for the previous data set)
if (is.null(input$columns) || !(input$columns %in% names(dat)))
return()
# Keep the selected columns
dat <- dat[, input$columns, drop = FALSE]
# Return
dat
})
output$downloadData <- downloadHandler(
filename = function() {
('test.csv')
},
content = function(con) {
write.table(dat, row.names = FALSE, col.names=T, sep=",",con)
},
contentType="csv"
)
})
ui.r
shinyUI(pageWithSidebar(
headerPanel(""),
sidebarPanel(
uiOutput("choose_dataset"),
uiOutput("choose_columns"),
downloadButton("downloadData", style = "color: white;background-color: #303030")
),
mainPanel(
tableOutput("data_table")
)
))
I am getting an error code in the downloadHandler that says it doesn't recognize dat. I have tried wrapping the elements in reactive({}), but that didn't work either.
I have tried several things to get the table to show with a page length, but nothing I am doing is working, so I don't have any code for that presented here.
Thanks for any help!
Just do the data wrangling outside. Try this
server <- shinyServer(function(input, output) {
# Drop-down selection box for which data set
output$choose_dataset <- renderUI({
selectInput("dataset", "Data set", as.list(data_sets))
})
# Check boxes
output$choose_columns <- renderUI({
# If missing input, return to avoid error later in function
if(is.null(input$dataset))
return()
# Get the data set with the appropriate name
dat <- get(input$dataset)
colnames <- names(dat)
# Create the checkboxes and select them all by default
checkboxGroupInput("columns", "Choose columns",
choices = colnames,
selected = colnames)
})
dat <- reactive({
# If missing input, return to avoid error later in function
if(is.null(input$dataset))
return()
# Get the data set
dat <- get(input$dataset)
# Make sure columns are correct for data set (when data set changes, the
# columns will initially be for the previous data set)
if (is.null(input$columns) || !(input$columns %in% names(dat)))
return()
# Keep the selected columns
dat <- dat[, input$columns, drop = FALSE]
# Return
dat
})
# Output the data
output$data_table <- renderTable({
dat()
})
output$downloadData <- downloadHandler(
filename = function() {
('test.csv')
},
content = function(con) {
write.table(dat(), row.names = FALSE, col.names=T, sep=",",con)
},
contentType="csv"
)
})
I am trying to take the speed variable from the "car" data set which I am uploading to the application. Basically Under select speed: I would like to have all the numbers appearing in the dataset$speed. Under selecInput, the choices should depend upond the data set I am uploading using fileInput. How can I complete this task. For now I have added the choices as 1,2,3. In theory there should be all values of the speed variable of cars data set.
library(shiny)
library(datasets)
##the file I am uploading
data(cars)
dataset=write.csv(cars, "dataset.csv")
ui=fluidPage(
actionButton("upload", "Upload File"),
bsModal("uploadFile", " ", "upload",
sidebarLayout(
sidebarPanel(
fileInput("file","Choose file to upload")
),
mainPanel(
tableOutput("contents")
)
)
),
sidebarLayout(
sidebarPanel(
column(3, selectInput("selectElement", "Select speed:", c(1,2,3),multiple =
T, selectize = F)
)
),
mainPanel(
)
)
)
server=function(input,output,session){
output$contents <- renderTable({
inFile <- input$file
if (is.null(inFile))
return(NULL)
read.csv(inFile$datapath)
})
}
shinyApp(ui,server)
My apologies in advance for a somewhat incomplete response: see below.
First of all, an answer to your query:
If you have a dataset like cars, to identify the "speed" labels you can do:
labls <- unique(cars$speed)
...
selectInput("selectElement", "Select speed:", labls, multiple =
T, selectize = F)
I was hoping to post a complete example, but the current logic (maybe because of the limited code posted?) does not seems right: how can the app a) leave to the user to select which file to use; and at the same time b) already filter for speed?
Of course it is possible that you plan to display datasets that have all a column called "speed", then it would make sense :)
Additionally, but this was not part of your question, you appear to use modal dialogues through the package shinyBS.
Since version 0.14 of shiny (around October 2016) shiny has a very good modal function and personally I think it would be better to use the native function instead.
I thougth to post a simple example derived from your code (but with the selectInput for speed commented out because, as mentioned, it does not appear right in the context of the example posted).
library(shiny)
library(datasets)
data(cars)
dataset = write.csv(cars, "dataset.csv")
labls <- unique(cars$speed) # I left this in the code
ui=fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("upload", "Upload File")
),
mainPanel(tableOutput("contents") )
))
server=function(input,output,session){
# Show modal when button is clicked.
observeEvent(input$upload, {
showModal(dataModal())
})
dataModal <- function(failed = FALSE) {
modalDialog(
fileInput('inputId', label=NULL, multiple = FALSE, accept = NULL, width = NULL, buttonLabel = "Browse...", placeholder = "No file selected")
# , selectInput("selectElement", "Select speed:", labls, multiple =
# T, selectize = F)
)
}
output$contents <- renderTable({
if (length(input$inputId )== 0) return(NULL)
inFile <- input$inputId
# if (is.null(input$selectElement )) return(NULL)
input$inputId
})
}
shinyApp(ui,server)
Here is an existing example
library(shiny)
runExample("06_tabsets")
And you will see you can choose distribution type in radiobutton and there are three tabs "Plot", "Summary", and "Table".
My question is how can I add a selectInput under the sliderInput(number of observations) with two values. The default one is "NULL", the second one is "1". Once users select "1", the previous three tabs would disappear. Instead, a new tab would show whatever it content is.
This is the modified "06_tabsets". A select input is added and the UI is generated depending of the selection. The only difference is that is not using NULL, but two options. I could make it run with NULL. Let me know if this helps.
ui.R
library(shiny)
# Define UI for random distribution application
shinyUI(fluidPage(
# Application title
titlePanel("Tabsets"),
# Sidebar with controls to select the random distribution type
# and number of observations to generate. Note the use of the
# br() element to introduce extra vertical spacing
sidebarLayout(
sidebarPanel(
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")),
br(),
sliderInput("n",
"Number of observations:",
value = 500,
min = 1,
max = 1000),
selectInput("contentSelect", "Select content to dislay:", choices = c("1", "2"), selected = 1)
),
# Show a tabset that includes a plot, summary, and table view
# of the generated distribution
mainPanel(
uiOutput("content")
)
)
))
server.R
library(shiny)
# Define server logic for random distribution application
shinyServer(function(input, output) {
# Reactive expression to generate the requested distribution.
# This is called whenever the inputs change. The output
# functions defined below then all use the value computed from
# this expression
data <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
dist(input$n)
})
# Generate a plot of the data. Also uses the inputs to build
# the plot label. Note that the dependencies on both the inputs
# and the data reactive expression are both tracked, and
# all expressions are called in the sequence implied by the
# dependency graph
output$plot <- renderPlot({
dist <- input$dist
n <- input$n
hist(data(),
main=paste('r', dist, '(', n, ')', sep=''))
})
# Generate a summary of the data
output$summary <- renderPrint({
summary(data())
})
# Generate an HTML table view of the data
output$table <- renderTable({
data.frame(x=data())
})
output$textA <- renderText({
paste(input$contentSelect, " A")
})
observeEvent(input$contentSelect, {
if (input$contentSelect == "1") {
output$content <- renderUI({
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
})
} else {
output$content <- renderUI({
tabsetPanel(type = "tabs",
tabPanel("A", textOutput("textA"))
)
})
}
})
})
I am trying to populate a Typeahead box in Shiny, using the ShinySky package in R.
I'm trying to extend the example, where the data used to prepopulate the Typeahead is hardcoded into the textInput.typeahead function:
textInput.typeahead(
id="thti"
,placeholder="type 'name' or '2'"
,local=data.frame(name=c("name1","name2"),info=c("info1","info2")) #<- LOOK!
,valueKey = "name"
,tokens=c(1,2)
,template = HTML("<p class='repo-language'>{{info}}</p> <p class='repo-name'>{{name}}</p> <p class='repo-description'>You need to learn more CSS to customize this further</p>")
)
Having a local dataframe defined in the middle of the function is not what I would like to do, as the example has done here:
,local=data.frame(name=c("name1","name2"),info=c("info1","info2"))
I would like to supply an argument to local that is a reactive object, which is created elsewhere in Shiny.
So far I've been unable to do so.
Here's my strategy for attempting to populate the Lookhead options dynamically using reactivity:
1) Let the user subset a dataframe using a slider.
2) Set up the Lookahead to read in the subsetted dataframe, using something like ,local=subset(DF)
3) Hope that the Lookahead works as it's supposed to.
Seems simple enough? Here's a screenshot, where you can clearly see that the Lookhead doesn't appear underneath the user input of 111. Below is my code. Any help would be greatly appreciated.
library(shiny)
library(shinysky)
options(shiny.trace = F) # change to T for trace
DF <- data.frame(ID=c("111", "222", "333", "444"), info=c("info1", "info2", "info3", "info4"))
runApp(list(ui = pageWithSidebar(
headerPanel("This is a test"),
sidebarPanel(
helpText("I couldn't live without StackOverflow"),
sliderInput("range",
label = "Pick how many rows you want in your dataframe:",
min = 2, max = 4, value = 2, step=1),
helpText("After subsetting the dataframe using the controls above, can we make the Lookahead work?"),
textInput.typeahead(
id="thti"
,placeholder="type ID and info"
,local=subset(DF)
,valueKey = "ID"
,tokens=c(1,2)
,template = HTML("<p class='repo-language'>{{info}}</p> <p class='repo-name'>{{ID}}</p> <p class='repo-description'></p>"))
),
mainPanel(textOutput("text1"),
htmlOutput("text"),
tableOutput('table')
)
),
server = function(input, output, session) {
subsetDF <- reactive({ DF <- DF[1:input$range, ]
DF
})
output$text <- renderUI({
str <- paste("This is how many rows you've chosen for your dataframe:",
input$range)
HTML(paste(str, sep = '<br/>'))
})
output$table <- renderTable(subsetDF())
}
)
)
My shiny app has multiple tabPanels and I want to have a selectizeInput on each of these. However, the input only appears to update on the first panel - ie selectizeInput appears to work only on the first tab. The code below has two identical selectizeInputs which are the updated. Apologies if this is not reproducible elsewhere as it does seem to be odd behavior.
d <- c('t','u','o')
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel('a',uiOutput('a')),
tabPanel('b',uiOutput('b'))
))
server <- function(input, output, session){
output$a <- renderUI({
req(d)
selectizeInput(
'a','test1',choices = NULL,
options = list(placeholder = 'Please select from below'),
multiple = TRUE)
})
observe({
req(d)
updateSelectizeInput(session,
'a',choices = d,
selected = NULL, server = TRUE)
})
output$b <- renderUI({
req(d)
selectizeInput(
'b','test2', choices = NULL,
options = list(placeholder = 'Please select from below'),
multiple = TRUE)
})
observe({
req(d)
updateSelectizeInput(session,
'b',choices = d,selected = NULL,
server = TRUE)
})
}
shinyApp(ui, server)
It is reproducible (thanks!) and the answer is quite simple.
The problem lies in the order your elements are rendered.
(Description might be messy, because you named your elements ambiguously.)
Explanation: Your selected tabPanel is a since it's the first tab available. Your selectizeInput a is therefore rendered. It gets rendered as you specified, with choices = NULL.
Then both observers fire (not because they observe something, but because the server runs through all commands from top to bottom including all observers.)
This leads to selectizeInput a being updated to your choices in d and selectizeInput b is also being updated. Note, that at this point, selectizeInput b wasn't even rendered yet!
So, as you click on tabPanel b, selectizeInput b is rendered for the first time, and as you specified, it is rendered with choices = NULL. Voilà, no choices available.
Solution: You want your observers to observe, so to be run anytime something happens that is important to the observers content. In this case, that is a tabPanel change. In the code below, I added an id to your tabsetPanel and let the observers hear anything that happens with it.
d <- c('t','u','o')
library(shiny)
ui <- fluidPage(
tabsetPanel(id = "x",
tabPanel('a',uiOutput('a')),
tabPanel('b',uiOutput('b'))
))
server <- function(input, output, session){
output$a <- renderUI({
req(d)
selectizeInput(
'a','test1',choices = NULL,
options = list(placeholder = 'Please select from below'),
multiple = TRUE)
})
observe({
req(d)
trigger <- input$x
updateSelectizeInput(session,
'a',choices = d,
selected = NULL, server = TRUE)
})
output$b <- renderUI({
req(d)
selectizeInput(
'b','test2', choices = NULL,
options = list(placeholder = 'Please select from below'),
multiple = TRUE)
})
observe({
req(d)
trigger <- input$x
updateSelectizeInput(session,
'b',choices = d,selected = NULL,
server = TRUE)
})
}
shinyApp(ui, server)
Note: One might even cut one of the observers, and have the remaining one react to the value of input$x.