In the code posted at the bottom, I'm trying to cap the value of the second reactive object (y) at the value of the first reactive object (x) using two observeEvents() as action button click counters, as explained in the illustration below. The illustration shows the results of clicking the "Pos" button 3 times and the "Neg" button 4 times. How would this be done?
I commented-out one of my attempts in the below code.
Illustration:
Code:
library(shiny)
ui <- fluidPage(br(),
actionButton("Btn1", "Pos"),
actionButton("Btn2", "Neg"),
br(),br(),
textOutput("posClicks"),
textOutput("negClicks"),
textOutput("netClicks")
)
server <- function(input, output, session) {
x = reactiveVal(0)
y = reactiveVal(0)
observeEvent(input$Btn1,{x(x()+1)})
observeEvent(input$Btn2,{y(y()+1)})
# below is commented-out because it gives strange results counting in leaps of 2's
# observeEvent(input$Btn2,{
# if(x()-y(y()+1) >= 0){y(y()+1)}
# })
output$posClicks <- renderText({paste('Pos clicks =',x())})
output$negClicks <- renderText({paste('Neg clicks =',y())})
output$netClicks <- renderText({paste('Net clicks =',x()-y())})
}
shinyApp(ui, server)
If you really need to have two separate observes, you could do
observeEvent(input$Btn1,{x(x()+1)})
observeEvent(input$Btn2,{y(y()+1)})
observe({
if (y()>x()) {y(x())}
})
Rather than listening for clicks on the button, you just observe the value of y() and if it gets bigger than x(), just reset it. If you can, it would be easier just to change the Btn2 logic
observeEvent(input$Btn1,{x(x()+1)})
observeEvent(input$Btn2,{y(min(y()+1, x()))})
Related
i'm new in shiny, but i try to write a simple app. It will connect to DB, download DF and print it on site. And i got this. Now I want to pick range to save as csv a part of that DF.
So I have to input labels: Start and Stop, and Action Button.
I tried to find information how to implement that functionality, and i didn't. I found some info about observe function, but it's totaly not working in my example. When I do it as in official doc, after button click noting is happend.
My code:
ui <- fluidPage(
titlePanel("Skrypt"),
DT::dataTableOutput("table"),
numericInput("Start", "Start", 0),
verbatimTextOutput("v1"),
numericInput("Stop", "Stop", length(a)),
verbatimTextOutput("v"),
actionButton("button", "Generate For Range")
)
server <- function(input, output) {
# Filter data based on selections
output$table <- DT::renderDataTable(DT::datatable({
data <- myDat}))
}
shinyApp(ui, server)
And only what I tried to do is save Start and Stop as a variables after click button to use it in function to generate_csv(df, start_v, stop_v) as args.
Can someone explain me how to do that in simple way?
One solution uses eventReactive. It creates a calculated value that only updates in response to an event. In this case, the click on your button. That provides a data frame you can use in renderDataTable. Any code to filter data frame moves to the eventReactive named df.
myDat <- data.frame(A = 1:3, B = LETTERS[1:3]) # dummy data for testing
ui <- fluidPage(
titlePanel("Skrypt"),
DT::dataTableOutput("table"),
numericInput("Start", "Start", 1),
verbatimTextOutput("v1"),
numericInput("Stop", "Stop", 2),
verbatimTextOutput("v"),
actionButton("button", "Generate For Range")
)
server <- function(input, output) {
df <- eventReactive(input$button, {
# Test if filter is valid
if (input$Start >= input$Stop) stop("Start cannot be larger or equal than stop")
if (input$Start < min(myDat$A)) stop("Start cannot be less than smallest value")
if (input$Stop > max(myDat$A)) stop("Stop cannot be larger than largest value")
myDat[input$Start:input$Stop,] # use any filter you deem necessary
})
# Filter data based on selections
output$table <- DT::renderDataTable({
d <- DT::datatable(
data <- df()
)
})
}
shinyApp(ui, server)
I have a shiny app that has a DT::renderDataTable, the user can select a row in the datatable.
The following bit of code will only print FALSE (when a row is selected):
observeEvent(input$segment_library_datatable_rows_selected, {
print(is.null(input$segment_library_datatable_rows_selected))
})
How do I get it to print when a row is also deselected? (The print value would be TRUE)
observeEvent(input$selected,ignoreNULL = FALSE,{...})
ignoreNULL is defaulted to TRUE. Set to FALSE to have the event observed upon deselection.
As I understand a working minimal example would be the following (sel() reactive is TRUE if a row in datatable is selected):
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("datatable"),
textOutput("any_rows_selected")
)
server <- function(input, output) {
# Output iris dataset
output$datatable <- DT::renderDataTable(iris, selection = "single")
# Reactive function to determine if a row is selected
sel <- reactive({!is.null(input$datatable_rows_selected)})
# Output result of reactive function sel
output$any_rows_selected <- renderText({
paste("Any rows selected: ", sel())
})
}
shinyApp(ui, server)
Alternatively you can use observe() which will respond to any hits to the input$datatable_rows_selected, including NULL.
To repurpose Kristoffer W. B.'s code:
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("testtable")
)
server <- function(input, output) {
# Output iris dataset
output$testtable<- DT::renderDataTable(iris, selection = "single")
# Observe function that will run on NULL values
an_observe_func = observe(suspended=T, {
input$testtable_rows_selected
isolate({
#do stuff here
print(input$testtable_rows_selected)
})
})
#start the observer, without "suspended=T" the observer
# will start on init instead of when needed
an_observe_func$resume()
shinyApp(ui, server)
A few things to note:
1) I found it best to start the observer in suspended mode, that way it doesn't start when the program initializes. You can turn it on whenever you want it to... observe... (such as after you render the datatable, or before you'd like to start tracking selections).
2) Use isolate to stop the observer from tracking multiple elements. in this case the observer should only react to input$testtable_rows_selected, instead of everything else occurring. The symptom of this problem is that your observer fires multiple times on a single change.
I'm trying to build an step by step app using Shiny. My aim is creating an examen consisting in a bunch of questions written in a database. What I need is a "next" button which when you click another question shows up.
I've been triying with an "action button" but it just works the first time, that is, the first time that it is clicked a question shows up, but it becomes unclickable once clicked for first time (it doesn't work as a "next button" as I wish).
Here is the code:
Server.R:
library(xlsx)
data<-read.xlsx("data/base.xlsx",sheetName="Full1")
shinyServer(function(input, output) {
data[,2]<-as.character(data[,2])
question<-data[2,2]
ntext <- eventReactive(input$goButton, {
question
})
output$nText <- renderText({
ntext()
})
})
ui.R:
shinyUI(pageWithSidebar(
headerPanel("Exam"),
sidebarPanel(
actionButton("goButton", "Next"),
p("Next Question")
),
mainPanel(
verbatimTextOutput("nText")
)
))
Thank you so much.
You can do something like this. Please note the comments in the code
rm(list = ls())
library(shiny)
questions <- c("What is your name?","Can you code in R?","Do you find coding fun?","Last Question:How old are you?")
ui <- pageWithSidebar(
headerPanel("Exam"),
sidebarPanel(actionButton("goButton", "Next"),p("Next Question")),
mainPanel(verbatimTextOutput("nText")))
server <- function(input, output,session) {
# Inititating reactive values, these will `reset` for each session
# These are just for counting purposes so we can step through the questions
values <- reactiveValues()
values$count <- 1
# Reactive expression will only be executed when the button is clicked
ntext <- eventReactive(input$goButton,{
# Check if the counter `values$count` are not equal to the length of your questions
# if not then increment quesions by 1 and return that question
# Note that initially the button hasn't been pressed yet so the `ntext()` will not be executed
if(values$count != length(questions)){
values$count <- values$count + 1
return(questions[values$count])
}
else{
# otherwise just return the last quesion
return(questions[length(questions)])
}
})
output$nText <- renderText({
# The `if` statement below is to test if the botton has been clicked or not for the first time,
# recall that the button works as a counter, everytime it is clicked it gets incremented by 1
# The initial value is set to 0 so we just going to return the first question if it hasnt been clicked
if(input$goButton == 0){
return(questions[1])
}
ntext()
})
}
shinyApp(ui = ui, server = server)
In my below example, once run in RStudio, by clicking on the "play" button on the slider, the number of rows displaced gradually increases. But by pausing, and then changing the data set name to iris, then clicking the button "Show" and re-clicking "play", the same animated increase in number of rows does not occur...why? and how do i adjust my code to do so...i.e. let the animation occur with a different data set?
The example below is partially adapted from the eventReactive() function
require(shiny)
if (interactive()) {
ui <- fluidPage(
column(4,
sliderInput('x',label='Num Rows',min=2,max=30,step=1,value=3,animate = TRUE),
textInput('tbl_nm',label='Data Set',value='cars'),
br(),
actionButton("button", "Show")
),
column(8, tableOutput("table"))
)
server <- function(input, output) {
# reactively adjust the number of rows
ll <- eventReactive(input$x,{
input$x
})
# change the data sets after clicking the button
dat <- eventReactive(input$button,{
if(input$tbl_nm=='cars'){
dat <- cars
} else {
dat <- get(input$tbl_nm)
}
return(dat)
})
# Take a reactive dependency on input$button, but
# not on any of the stuff inside the function
df <- eventReactive(input$button, {
yy <- ll()
# choose only the relevant data...
head(dat(),yy)
})
# show the final table
output$table <- renderTable({
if(input$button==0){
# show the first few lines of cars at the begining
head(cars, ll())
} else {
# show the selected data
df()
}
})
}
shinyApp(ui=ui, server=server)
}
The reason this is happening is:
output$table <- renderTable({
if(input$button==0){
# show the first few lines of cars at the begining
head(cars, ll())
} else {
# show the selected data
df()
}
})
Every time a button is pressed, its value (input$button) increments by one. It is only 0 when the app opens. Therefore,
head(cars, ll()) only runs before the button is pressed the first time. Afterwards, input$button increments and its value is 2, 3, 4, ... etc.
ll() is an event reactive that depends on input$x (your slider). Therefore, when your slider updates, or when the play sign is pressed, ll() updates, and your table redisplays.
For every time after the first press, df() runs instead. This is an event reactive that depends on input$button - it only runs when the button is pressed. Your table is prevented from updating until the button is pressed.
To fix this, you can use:
df <- eventReactive(input$button | input$x, {
yy <- ll()
# choose only the relevant data...
head(dat(),yy)
})
as your df() instead. It will now update if the button is pressed or if the slider updates
What I'm trying to do is create an arbitrary number of action button, each of which has their own event based on their own individual values.
Let's say we want to create a number of buttons. What we do is draw a random number between 1 and 100 and call it n. Then we create n buttons, each with a value between 1 and n (covering every number once). Then, when we press one of those buttons, we render a text message being the number that we pressed.
To set up the buttons, we have:
ui.R
shinyUI(fluidPage(
actionButton('roll','roll'),
uiOutput('buttons')
))
Server.R
shinyServer(function(input, output) {
n <- eventReactive(input$roll, {
num <- sample(1:100,1)
sample(1:num, num, replace=FALSE)
})
output$buttons <- renderUI({
lapply(1:length(n()), function(i) {
actionButton(as.character(n()[i]), as.character(n()[i]) )
})
})
})
This generates the buttons. However, I'm struggling to find a way to create all the necessary eventReactive()s. I tried calling eventReactive() inside a loop, and in a lapply call. However, in order to make that loop or lapply, you need the value of length(n()), which can only be called inside another reactive or observe command.
Given the buttons generated from the above script, how do we make a reactive expression for each button, and then output the text corresponding to the number pressed?
You can search through the input looking for buttons that have been triggered. Once a button is clicked, its value is greater than 0, so all the picked values will print this way (not sure if that is desired?)
library(shiny)
shinyApp(
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton('roll','roll'),
uiOutput('buttons')
),
mainPanel(
textOutput('stuff')
)
)
)),
shinyServer(function(input, output) {
n <- eventReactive(input$roll, {
num <- sample(1:100,1)
sample(1:num, num, replace=FALSE)
})
output$buttons <- renderUI({
lapply(1:length(n()), function(i) {
actionButton(as.character(n()[i]), as.character(n()[i]) )
})
})
output$stuff <- renderText({
val <- which(lapply(paste(n()), function(i) input[[i]]) == TRUE)
if (length(val))
sprintf("Picked %s!", paste(n())[val])
})
})
)