I am relatively new to shiny app and is trying to make a simple app : while i am able to run ui.R correctly, i am having problem with server.R......what i want is to take a value of slider bar "post" (this number will be used as arg. of function "wbpg"),select the type of plot from dropdown menu and plot the corresponding variable when action button "RUN" is pushed.....all the results and plots are saved when a function named "wbpg(x)" (where "x" is the value of slider bar)...when wbpg(x) is run it returns plots(this contains list of all the plots in drop down menu)
#UI.R
shinyUI( fluidPage(
titlePanel(title=h4("Text Mining on thread",align="centre")),
sidebarLayout(
sidebarPanel(
sliderInput("post","1. Choose no. of posts you want to run the model",value = 1, min = 1, max = 30000),
br(),
selectInput("plotvar","2. Select the variable you want to plot",choices=c("raw_dat"=1,"content"=2,"barplot"=3,"genderplot"=4,"girlplot"=5,"rawplot"=6,"adjplot"=7,
"drinkplot"=8,"damageplot"=9,"songplot"=10,"sentimentplot"=11)),
br(),
actionButton(inputId="act",label = "RUN!")
),
mainPanel(
textOutput("out"),
#tableOutput("tab"),
plotOutput("hist1")
)
)
))
this is server file, where the problem exists:
#server.R
shinyServer(function(input, output) {
#observeEvent(input$action,wbpage(as.numeric(input$post)))
#output$data<-renderPrint({str(get(content))})
observeEvent(input$act,{wbpg(np)})
output$out<-renderText(paste("No. of posts mined: ",input$post))
#defaul<-reactiveValues(data=wbpage(3000))
np<-wbpage(as.numeric(input$post))
output$hist1 <- renderPlot({barplot})
})
#output$hist1 <-
#renderPlot({
#plots$barplot
#output$tab<-
# renderTable({
# head(data())
#})
#output$hist2 <- renderPlot({
#hist(rnorm(input$num))
#raunchyplot
#})
#})
Without having access to your function (wbpg), let me try to help you with the values returned from the 'observeEvent' call. I think your problem is the placement of the '})' on the line with 'observeEvent'. Everything you want to happen upon clicking the 'Run' button needs to be within the '})'. If this isn't what you need, please restate the question.
In place of your 'observeEvent' command, use the following code to see the data returned every time you click on the 'Run' button. It shows the value of the slider bar and the number from the drop down menu.
observeEvent(input$act,{
print (paste(input$post,input$plotvar,sep=' '))
})
Related
I added the button but the values will automatically change before I hit "Update Order", I don't know how to fix it. Should be like this:enter image description hereBelow is my code:
library(shiny)
ui <- fluidPage(
titlePanel("My Simple App"),
sidebarLayout(
sidebarPanel(
helpText("Controls for my app"),
selectInput("fruitchoice",
label = "Choose a fruit",
choices = list("Apples",
"Oranges",
"Mangos",
"Pomegranate"),
selected = "Percent White"),
sliderInput("amt",
label = "Order Amount:",
min=0, max = 100, value=20),
actionButton ("Update","Update Order")
),
mainPanel(
helpText("Fruit Chosen:"),
verbatimTextOutput("fruit"),
helpText("Order Amount"),
verbatimTextOutput("amt")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
SelectInput <- eventReactive (input$Update , {
runif(input$fruitchoice,amt)
})
output$fruit = renderText(input$fruitchoice)
output$amt = renderText(input$amt)
}
# Run the application
shinyApp(ui = ui, server = server)
I will show you, how to rewrite your code to get this update behavior, however I would like to also get you know that this part of code:
SelectInput <- eventReactive (input$Update , {
runif(input$fruitchoice,amt)
})
Is wrong for three reasons: (1) object amt do not exists, you probably want input$amt; (2) even if you change amt to input$amt code won't work and you will get error; (3) now you are not using SelectInput in any place in your application, so there is no reason for this part to exists, however as I don't know what is your aim and how will look the final app, I'm not saying this is generally wrong.
Ok, so now about this update button. We will focus on this code:
output$fruit = renderText(input$fruitchoice)
output$amt = renderText(input$amt)
Here you instruct program to (re)render text when input$fruitchoice or (in second line) when input$amt change, but you want to (re)render text only when user clicks the button, so you need two things - first, be sure that user clicked the button and do not (re)render text when one of input$ changes. This will work:
output$fruit = renderText({
req(input$Update)
isolate(input$fruitchoice)
})
output$amt = renderText({
req(input$Update)
isolate(input$amt)
})
If I understand Shiny correctly, isolate() makes sure that text is not (re)rendering when input$ changes (however it has internally the new values) and req() makes sure that the input$Update was clicked; and when is clicked again, Shiny recomputes [(re)renders] text. It recomputes, because we didn't use isolate() on input$Update I think.
There's a few things wrong in your code. I will give a bit of explanation for each one:
You are initializing with reactive inputs. By using renderText(input$...) you create a text output that updates automatically when your input updates. Automatically is the problem here, you don't want that. We are going to write an alternative method that stores the inputs in a separate variable that we only allow to be updated when the button is pressed. We initialize that variable like so:
rv <- reactiveValues(fruit = "Apples",
amt = 20)
EventReactive creates a reactive variable that can later be used in the code. Generally speaking what you want to use in these kind of scenarios is observeEvent. You can do so like this:
observeEvent (input$Update , {
rv$fruit <- input$fruitchoice
rv$amt <- input$amt
})
We now have a list of variables under the name "rv" and an observeEvent that updates this variable every time the button gets pressed. All that is left to do is create the renderText which you can do like so:
output$fruit <- renderText(rv$fruit)
output$amt <- renderText(rv$amt)
Description
I have a textAreaInput box that I want to start with a default value. The user can click 2 actionButtons (Submit & Random Comment). Submit updates the comment from the textAreaInput for further processing (plot, etc.) while Random Comment sends a new random value to textAreaInput (the user may type in the textAreaInput box as well). I almost have it but can't get the app to update textAreaInput's value until the Submit button is pressed.
Question
I want it to be updated when Random Comment is pressed but still allow the user to erase the text box and type their own text. How can I make the app do this?
MWE
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
output$randcomment <- renderUI({
commentUi()
})
comment_value <- reactiveValues(default = 0)
observeEvent(input$submit,{
comment_value$default <- input$randtext
})
renderText(input$randtext)
commentUi <- reactive({
if (comment_value$default == 0) {
com <- stri_rand_lipsum(1)
} else {
com <- stri_rand_lipsum(1)
}
textAreaInput("comment", label = h3("Enter Course Comment"),
value = com, height = '300px', width = '300px')
})
output$commenttext <- renderText({ input$comment })
}
)
I'd approach this a little bit differently. I would use reactiveValues to populate both of the fields, and then use two observeEvents to control the contents of the reactiveValues.
I don't think you need a reactive at all in this situation. reactive is good when you want immediate processing. If you want to maintain control over when the value is processed, use reactiveValues.
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
# Reactive lists -------------------------------------------------------
# setting the initial value of each to the same value.
initial_string <- stri_rand_lipsum(1)
comment_value <- reactiveValues(comment = initial_string,
submit = initial_string)
# Event observers ----------------------------------------------------
observeEvent(input$randtext,
{
comment_value$comment <- stri_rand_lipsum(1)
}
)
# This prevents the comment_value$submit from changing until the
# Submit button is clicked. It changes to the value of the input
# box, which is updated to a random value when the Random Comment
# button is clicked.
observeEvent(input$submit,
{
comment_value$submit <- input$comment
}
)
# Output Components -------------------------------------------------
# Generate the textAreaInput
output$randcomment <- renderUI({
textAreaInput("comment",
label = h3("Enter Course Comment"),
value = comment_value$comment,
height = '300px',
width = '300px')
})
# Generate the submitted text display
output$commenttext <-
renderText({
comment_value$submit
})
}
)
Some comments on your code
I struggled a little with determining what your code was doing. Part of the reason was that your server function was organized a bit chaotically. Your components are
output
reactive list
observer
output (but not assigned to a slot...superfluous)
reactive object
output
I'd recommend grouping your reactives together, your observers together, and your outputs together. If you have truly separate systems, you can break the systems into different sections of code, but have them follow a similar pattern (I would claim that these two boxes are part of the same system)
Your commentUi reactive has a strange if-else construction. It always sets com to a random string. What's more, the if-else construction isn't really necessary because no where in your code do you ever update comment_value$default--it is always 0. It looks like you may have been trying to base this off of an action button at some point, and then concluded (rightly) that that wasn't a great option.
Also, I would advise against building UI components in your reactive objects. You'll find your reactives are much more flexible and useful if they return values and then build any UI components within the render family of functions.
I am trying to create a UI on which I can upload a file and also there is a text input where I can write the product name which I want to search in the uploaded file. I am doing that using the Levenshtein Distance function (adist() function). Now, once i get the results for which the edit distance is 0, I want to display those rows in the Table on the Main Panel. Whatever input is given in the Text input on the UI is searched against the items column in the file uploaded. A sample image of the CSV file which is uploaded is this-
Sample image of the CSV file which is input by the user
Once I run the code and find the edit distance for all the words, I store them in a vector and then use this to print the rows from the file which have edit distance equal to 0. The problem is that when I click on submit, the result is not displayed on the UI but it is displayed on the R-studio console. How do I fix this?
Please help me with the code.
library(shiny)
ui = shinyUI(fluidPage(
titlePanel("LEVENSHTEIN DISTANCE function trial"),
sidebarLayout(
sidebarPanel(
numericInput("rows","Enter the number of rows",value=NULL),
textInput("product", "input product name"),
br(),
br(),
fileInput("file", "Input the file"),
submitButton("Find!")),
mainPanel(
tableOutput("result")
)
)
))
server = shinyServer(function(input,output) {
output$result <- renderPrint({ if (is.null(input$file)) return( );
trial = read.csv(input$file$datapath)
ls = vector('list', length = input$rows)
for(i in 1:input$rows) {
edit = adist("earbuds", trial$items[i])
new_edit = as.numeric(edit)
ls[i] = edit
if(ls[i]==0) print(trial[i, ])
}
})
})
shinyApp(ui=ui,server=server)
Thank You!
It is very hard to provide working code without sample input date. But, here is my attempt at giving you what I think should work.
server = shinyServer(function(input,output) {
output$result <- renderTable({
if (!is.null(input$file)) {
trial = read.csv(input$file)
trial <- trial[adist('earbuds', trial$items) == 0), ]
}
})
})
If you provide input data and expected output table, I can edit the answer to be more precise.
This is my first question on stackoverflow, and I've been using R for 3 months. I have a lot to learn! Any help is much appreciated. Thank you in advance for your time.
What I WANT to happen:
The user selects a category (Animals or Foods) from a drop-down box and clicks Next once. The appropriate ui component will render and display. Then the Next button should be disabled (grayed-out) whenever the right box of the Chooser Input component is empty. Only when the user has at least one selection in the right box, should Next button be enabled and the user may click it.
The PROBLEM: After the Chooser Input component is rendered, the right box is empty, but Next is NOT disabled. Here is the error:
Warning in run(timeoutMs) :
Unhandled error in observer: argument is of length zero
observeEvent(input$widget2)
Below are a demo ui.R and sever.R to recreate my problem. (However, I will be implementing the solution into a larger, more complex GUI.) The code uses shinyBS, so you will first need to install the package and load the library. The code also uses chooserInput, which requires two files: chooser.R and www/chooser-binding.js. See the following link for more information:
http://shiny.rstudio.com/gallery/custom-input-control.html
ui
### The following libraries need to be loaded BEFORE runApp()
### library(shiny)
### library(shinyBS)
source("chooser.R") # Used for Custom Input Control UI component (chooserInput)
# chooser.R is saved in the same location as the ui.R and server.R files
# chooserInput also requires chooser-binding JScript script file, which should be located within "www" folder
shinyUI(navbarPage("navbarPage Title",
tabPanel("tabPanel Title", titlePanel("titlePanel Title"),
fluidPage(
#### NEW ROW #####################################################################################################
fluidRow(wellPanel(
# Instructions for initial screen
conditionalPanel(condition = "input.ButtonNext == 0", tags$b("Step 1: Choose category and click 'Next'")),
# Instructions for 'Foods'
conditionalPanel(condition = "input.ButtonNext == 1 && input.widget1 == 'Foods'", tags$b("Step 2: Move Food(s) of interest to the right box and click 'Next'")),
# Instructions for 'Animals'
conditionalPanel(condition = "input.ButtonNext == 1 && input.widget1 == 'Animals'", tags$b("Step 2: Move Animals(s) of interest to the right box and click 'Next'"))
)),
#### NEW ROW #####################################################################################################
fluidRow(
# Drop down box for first selection
conditionalPanel(
condition = "input.ButtonNext == 0",
selectInput("widget1", label = "",
choices = c("Foods",
"Animals"))),
# This outputs the dynamic UI components based on first selection
uiOutput("ui1")
),
#### NEW ROW #####################################################################################################
fluidRow(tags$hr()), # Horizontal line separating input UI from "Next" button
#### NEW ROW #####################################################################################################
fluidRow(
column(1, offset=10,
# UI component for 'Next' button
conditionalPanel(condition = "input.ButtonNext < 2", bsButton("ButtonNext", "Next"))
),
column(1,
HTML("<a class='btn' href='/'>Restart</a>")
)
)
) # End of fluidPage
) # End of tabPanel
)) # End of navbarPage and ShinyUI
server
shinyServer(function(input, output, session) {
# Widget to display when number of clicks of "Next" button (ButtonNext) = 1
output$ui1 <- renderUI({
if(input$ButtonNext[1]==1) {
print("I am in renderUI") # Used to help debug
# Depending on the initial selection, generate a different UI component
switch(input$widget1,
"Foods" = chooserInput("widget2", "Available frobs", "Selected frobs", leftChoices=c("Apple", "Cheese", "Carrot"), rightChoices=c(), size = 5, multiple = TRUE),
"Animals" = chooserInput("widget2", "Available frobs", "Selected frobs", leftChoices=c("Lion", "Tiger", "Bear", "Wolverine"), rightChoices=c(), size = 5, multiple = TRUE)
)
}
}) # End of renderUI
# Disable "Next" button when right side of multi select input is empty
observeEvent(input$widget2, ({
widget2_right <- input$widget2[[2]]
print(widget2_right) # Used to help debug
if(widget2_right == character(0)) {
updateButton(session, "ButtonNext", disabled = TRUE)
} else {
updateButton(session, "ButtonNext", disabled = FALSE)
}
})) # End of observeEvent
}) # End of shinyServer
A similar question (link below) mentioned using Priorities and Resume/Suspend but no example was provided. If that is a valid solution to my problem, please provide some code.
R shiny Observe running Before loading of UI and this causes Null parameters
EXTRA NOTE: The code provided is a small demo recreated from a much larger GUI that I developed for the user to make a series of selections, clicking 'Next' between each selection. Depending on the selections they make each step, new choices are generated from a csv file. Therefore, the ui component that is rendered and displayed is dependent on how many times the user has clicked 'Next' and which selections they've previously made. In the end, the selections are used to sort a large data set so the user can plot only the data they are interested in. The dual conditions are why I used conditionalPanel and the VALUE of the actionButton to render and display the current ui component that the user needs. My code works (except for the problem above - HA!). However, I have read that it is poor coding practice to use the VALUE of an actionButton. If there are any suggestions for another method to handle the dual conditions, please let me know.
In server.R, I replaced
if(widget2_right == character(0))
with
if(length(widget2_right)==0)
and now the program works as I wanted it to.
When the right-box is empty, widget2_right = character(0). I learned that comparing vectors to character(0) results in logical(0), not TRUE or FALSE. However, length(character(0)) = 0. Therefore, if(length(widget2_right)==0) will be TRUE whenever no selections are in the right-box.
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 ","