I am new to shiny, and may be asking basic question.
I have a dataset in local machine as of now, which has store numbers and the items it sells along with other data.
What I wish is an app that will select one store number, list all the items in that store, and then based on selection of the item show all data for that store and item.
Please find the code below
ui.R
library(shiny)
df<-read.csv("C:/Users/adey1/Office Projects/NGSC_Shiny/Ensembler App/Trial Started on 05-06-2015//example1.csv")
category<-unique(df$item_nbr)
store<-unique(df$store_nbr)
sidebarPanel(
selectInput(inputId = "Store",
label = "Store",
store),
uiOutput("items"),
mainPanel(textOutput('values'))
)
server.R
shinyServer(function(input, output) {
output$items<-renderUI({
item_list<-unique(df$item_nbr[which(df$store_nbr==input$Store)])
radioButtons("item1", "Select Item", item_list)
})
output$value<-renderTable(
subset(df,store_nbr==input$store & item_nbr==as.integer(input$item1))
)
})
Can you suggest what is wrong, and what needs to be done?
I found this changes on server side works:-
server.R
shinyServer(function(input, output) {
output$items<-renderUI({
item_list<-unique(df$item_nbr[which(df$store_nbr==input$Store)])
radioButtons("item1", "Select Item", item_list)
})
dataset=reactive({
y=which(df$store_nbr==input$Store & df$item_nbr==input$item1)
df1=as.data.frame(cbind(df$date[y],df$item_nbr[y],df$units[y],df$store_nbr[y]))
names(df1)=names(df)
df1
})
output$value<-renderTable(
dataset()
)
})
But this is very crude. Can someone get me easier solution?
Related
I have a Shiny app that wrangles a large csv file. Currently the user can select a facility_id number from a drop down menu to get a specific plot, see https://r.timetochange.today/shiny/Annual_Emissions2/. I would like to pass this id with a URL parameter like /?selected_facilities=1010040 so I can embed the plots in another website.
I have taken the code from How do you pass parameters to a shiny app via URL and tried to use it to update my selectInput() value in the server section of the Shiny app, but I don't really understand how the UI part is constructed so I am not getting it right. Any help would really be appreciated! Here is the relevant code:
#### shiny UI ####
facilities <- unique(ghg_emissions$facility_id)
ui <- fluidPage(
titlePanel("Annual Greenhouse Gas Emissions"),
sidebarLayout(
sidebarPanel(
selectInput("selected_facility",
"Select facility",
choices = facilities) # select input gives the drop down menu to select facilities
),
mainPanel(
plotlyOutput("facility_plot")
)
)
)
#### shiny server ####
server <- function(input, output, session) {
# Here you read the URL parameter from session$clientData$url_search
observe({
query <- parseQueryString(session$clientData$url_search)
if (!is.null(query[['selected_facility']])) {
updateSelectInput(session, "selected_facility", value = query[['selected_facility']])
}
})
Your UI is good, the issue with the updateSelectInput, use selected rather than value and include choices.
Minimal working example:
library(shiny)
facilities <- seq(1:5)
ui <- fluidPage(
selectInput("selected_facility", "Select facility", choices = facilities)
)
server <- function(input, output, session) {
observe({
#Get URL query
query <- parseQueryString(session$clientData$url_search)
#Ignore if the URL query is null
if (!is.null(query[['selected_facility']])) {
#Update the select input
updateSelectInput(session, "selected_facility", selected = query[['selected_facility']], choices = facilities)
}
})
}
shinyApp(ui, server)
To test, run your shiny app, click 'Open in Browser' and append your query to the URL, e.g.
127.0.0.1:6054/?selected_facility=4
I am having a lot of trouble getting a search filtering module working.
I am to run stats on a large database of cat owner information.
I want my search module to bring up a list of possible owners(that the user can select from) based on a selection from a list of cat breeds.
I thought wrapping the updateSelectInput with observe and using a reactive cat owner expression would facilitate this, in the module, but it is not working( and I can't guess why this is happening or how to debug this). It worked in these other posts([1]:R shiny passing reactive to selectInput choices , [2]:using values from a reactive input to directly input into a custom function)
Why won't my selectInput update with cat owners?
library(shiny)
df=data.frame(
cat=c("tabby","DSH","MSH","LSH","DSH","MSH","LSH","sphinx"),
owner=c("Foo","Bar","Bash","Foo","Foo","Foo","Bar","Bash"),stringsAsFactors = F)
refinedSearch<-function(input, output, session){
ownsCat<-reactive({df[df$cat%in%input$cat,"owner"]})
observe({updateSelectInput(session, "ownerSelected",
label ="Owned By",choices = ownsCat())})
return()
}
refinedSearchUI<-function(id){
ns <- NS(id)
fluidRow(
column(4,selectInput(ns("cat"),"Cat",selectize = T,
choices =c("tabby","DSH","MSH","LSH","sphinx") )),
column(4,selectInput(ns("ownerSelected"),"Owned By","",selectize = T))
)
}
ui <- fluidPage(
h1("Find cats owners"),
fluidRow(column(10,offset=1, refinedSearchUI("tmp"))),
fluidRow(column(10,offset=1, actionButton("addFilter","Add a Filter",
icon = icon("plus"))))
)
server <- function(input, output,session) {
refinedSearch(input,output,session)
observeEvent(input$add, {insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearch(input,output,session))})
}
shinyApp(ui = ui, server = server)
Thank y'all for you time.
There seems to be quite a bit of confusion on how to call modules. You need to use the callModule() function in the server. Also, when inserting UI (using the insertUI()function), you need to call the refinedSearchUI() function, not the refinedSearch() function (which, again, should always be called through callModule(), so it should never actually get called directly like that).
I'd recommend a re-reading of the modules article.
You also have a typo. The event in your observeEvent() function should be input$addFilter, not input$add (which doesn't exist, so that observer is never fired..)
If you change your server function to this, your app will work as expected:
server <- function(input, output,session) {
callModule(refinedSearch, "tmp")
observeEvent(input$addFilter, {
id <- paste0("filter_", input$add)
insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearchUI(id))
callModule(refinedSearch, id)
})
}
Let's say we have a set of widgets each with their own input label. How do we create a reactive object whose value is the character that represents the input ID of the last widget that was modified?
For example, if we have
ui.R
shinyUI(fluidPage(
textInput('txt_a', 'Input Text A'),
textInput('txt_b', 'Input Text B")
))
server.R
shinyServer(function(input, output) {
last_updated_widget <- reactive({
#hypothetical code that indicates ID value of last updated widget
})
})
The desired result is as follows. If the user modifies the first text box, then the value of last_updated_widget() would be "txt_a". If they modify the second box, the value of last_updated_widget() becomes "txt_b". I'm in search of a result that extends to the obvious generalization of setting the value to be the ID of any of the widgets that was adjusted last.
I'd like this to work for an arbitrary number of widget inputs, including the case that they were generated by a renderUI() statement. So making a separate reactive() statement for each widget isn't an option. However, if the reactive statement requires a loop over all the widget names (or something like that) I can certainly work with that. And multiple reactive statements is okay, as long as it's a fixed amount, and not a function of the number of widgets.
It seems like a pretty simple problem, so I was surprised when it became a roadblock for me. I feel like the solution would be really obvious and I'm just not seeing, so if it is, I apologize for making it a new question. But any help would be greatly appreciated.
Here's a solution that works, though it looks a little awkward because of a nested observe(). I'm not sure what a better way would be, but there could be something nicer.
Basically, use an observe() to loop over all the available inputs, and for each input, use another observe() that will only trigger when that input is changed and set a variable to the id of the input.
runApp(shinyApp(
ui = shinyUI(
fluidPage(
textInput('txt_a', 'Input Text A'),
textInput('txt_b', 'Input Text B'),
uiOutput('txt_c_out'),
verbatimTextOutput("show_last")
)
),
server = function(input, output, session) {
output$txt_c_out <- renderUI({
textInput('txt_c', 'Input Text C')
})
values <- reactiveValues(
lastUpdated = NULL
)
observe({
lapply(names(input), function(x) {
observe({
input[[x]]
values$lastUpdated <- x
})
})
})
output$show_last <- renderPrint({
values$lastUpdated
})
}
))
You can use a reactive value created with reactiveValues() to store the name of the last used widget. Later use an observer to keep track of the activity of each widget and update the reactive value with the name of the last used widget.
In the folowing example, the name of the last used widget is stored in last_updated_widget$v and will active the verbatimTextOutput each time it changes. You can use last_updated_widget$v at any place in the server.
library(shiny)
runApp(list(
ui = shinyUI(
fluidPage(
textInput('txt_a', 'Input Text A'),
textInput('txt_b', 'Input Text B'),
verbatimTextOutput("showLast")
)
),
server = function(input, output, session) {
last_updated_widget <- reactiveValues( v = NULL)
observe ({
input$txt_a
last_updated_widget$v <- "txt_a"
})
observe ({
input$txt_b
last_updated_widget$v <- "txt_b"
})
output$showLast <- renderPrint({
last_updated_widget$v
})
}
))
In shiny, how do you use tagList inside renderUI to create multiple widgets customized with data from an uploaded file? This idea is referenced here, but there doesn't appear to be very good documentation for tagList.
I plan to answer my own question here. I did a bit of research, found that a simple example of this process was lacking, and felt a desire to contribute it so that others might benefit.
In server.R, define an object using a reactive() statement to hold the contents of the uploaded file. Then, in a renderUI statement, wrap a comma-delimited list of widget definitions in a tagList function. In each widget, use the object holding the contents of the uploaded file for the widget parameters. The example below, hosted at shinyapps.io and available on github, creates a checkBoxGroupInput and a radioButtons widget using a singer renderUI that is defined based on an uploaded file.
server.R
library(shiny)
shinyServer(function(input, output) {
ItemList = reactive(
if(is.null(input$CheckListFile)){return()
} else {d2 = read.csv(input$CheckListFile$datapath)
return(as.character(d2[,1]))}
)
output$CustomCheckList <- renderUI({
if(is.null(ItemList())){return ()
} else tagList(
checkboxGroupInput(inputId = "SelectItems",
label = "Which items would you like to select?",
choices = ItemList()),
radioButtons("RadioItems",
label = "Pick One",
choices = ItemList(),
selected = 1)
)
})
})
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Create a checkboxGroupInput and a RadioButtons widget from a CSV"),
sidebarLayout(
sidebarPanel(fileInput(inputId = "CheckListFile", label = "Upload list of options")),
mainPanel(uiOutput("CustomCheckList")
)
)
))
I have begun to create a web app using shiny where a user enters a search term and tweets containing that term are returned.
When I load this app the searchTwitter function begins automatically and on the main panel there is the error: Error: You must enter a query.
The search term is entered in the textInput box and there is a submitButton. You can enter a term and it works fine but I don't want the error to be the first thing the user sees.
ui.R:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Twitter Generator"),
sidebarPanel(
textInput("search", "Search Twitter For:", value = ""),
submitButton("Search")
),
mainPanel(
h3(textOutput("search")),
tableOutput("view"),
)
))
server.R:
library(shiny)
library(twitteR)
shinyServer(function(input, output) {
datasetInput <- reactive(function(){
rawTweets <- twListToDF(searchTwitter(paste(input$search)))
rawTweets$cleanText <- as.vector(sapply(rawTweets$text, CleanTweet))
rawTweets[, colnames(rawTweets) != "created"]
})
output$search <- reactiveText(function() {
input$search
})
output$view <- reactiveTable(function() {
head(datasetInput())
})
})
Thanks for your help
This is a logical request for and from your application design, and you should think through how to do it.
One easy way would be to add a tickbutton providing a true/false and to skip the actual twitter search if the value is FALSE. You may need to cache the previous value of rawTweets, or set it to NULL, or ...
mainPanel(
h3(textOutput("search")),
tableOutput("view")
)
try it without the second ","