I am having problems making a reactive app to show the map of a given state. I want the app to react ONLY WHEN I click "Show map", but for some reason with the following code, after the first click on "Show map", the output changes whenever I change the input (state), whether or not I click the button again.
library(shiny)
ui <- fluidPage(
titlePanel("Show map of a given state"),
sidebarLayout(
sidebarPanel(
textInput("state", label = "State", value = "CA", placeholder = "California or CA"),
actionButton("showU","Show map")
),
mainPanel(
conditionalPanel(
condition = "input.showU > 0",
h3(textOutput("state")),
uiOutput("url")
)
)
)
)
server <- function(input, output){
observeEvent(input$showU,{
output$state <- renderText(paste("Map of", input$state, ":"))
output$url <-renderUI({a(href=paste("https://www.google.com/maps/place/", input$state, sep=""),"Show in Google Map",target="_blank")})
})
#output$state <- eventReactive(input$showU, renderText(paste("Map of", input$state, ":")))
#output$url <- eventReactive(input$showU, renderUI({a(href=paste("https://www.google.com/maps/place/", input$state, sep=""),"Show in Google Map",target="_blank")}))
}
shinyApp(ui,server)
I thought observeEvent or eventReactive (the code that's commented out; doesn't work either) is supposed to delay reaction until I click the action button but it's not doing that. Can anybody help me figure out what is wrong here? Thank you!
It's because you call input$xxx within renderYYY. You can use isolate():
observeEvent(input$showU,{
output$state <- renderText(paste("Map of", isolate(input$state), ":"))
output$url <-renderUI({a(href=paste("https://www.google.com/maps/place/", isolate(input$state), sep=""),"Show in Google Map",target="_blank")})
})
Related
Problem statement: on click of a button (say reset), we need to reset some controls and then programmatically click another button (in this case update) and perform some logic and render appropriately.
In the below example, I do the following
On click of the reset button, I am resetting the picker input using the reset function and then calling click on "update" button.
Expected
on click of reset, both the text should be NULL
What Happens is :
The first one is NUll, the second one is the last value
I Would like to understand the reason behind it. Interestingly when we debug, it works as expected. Is there a workaround to achieve something like this?
library(shiny)
library(shinyWidgets)
library(shinyjs)
options(shiny.reactlog=TRUE)
# if (interactive()) {
# library(shiny)
shinyApp(
ui = fluidPage(
useShinyjs(),
div(
id = "form",
pickerInput(
inputId = "letter",
label = "Select max two option below:",
choices = c("A", "B", "C", "D"),
multiple = TRUE,
selected = NULL,
options = list(`actions-box` = TRUE)
),
verbatimTextOutput("selected_value"),
verbatimTextOutput("reset_value"),
),
actionButton("reset", "Reset"),
actionButton("update", "Update"),
),
server = function(input, output) {
msg <- "temp reactive"
msg_reactive <- reactiveValues(text = msg)
output$reset_value <- renderPrint(msg_reactive$text)
output$selected_value <- renderPrint(input$letter)
observeEvent(input$reset, {
reset("letter")
click("update")
})
observeEvent(input$update,{
## some logic , currently just setting it to current value of drop down letters
## I assume click on line number 52 triggers the control to come here
## but still values in input$letter are older onces and not NULL
## if I use a browser and then executes it works , Not sure where I am falling short
msg_reactive[['text']] <- input$letter
})
}
)
# }
I have created a Shiny app that takes user input and creates a CA plot. It works just fine when I run the app locally, but for some reason when I deploy the dashboard, the image of the plot won't appear. I can see in the logs that the data uploading and reformatting into a proper data frame is working just fine, but the plot itself is failing to render.
Does anyone know why this might be? I posted my code below (you'll see some print() lines in my code that was used for debugging). Any help would be greatly appreciated!
#PERCEPTUAL MAPPING DASHBOARD
library(FactoMineR)
library(factoextra)
library(SensoMineR)
library(shinythemes)
library(ca)
ui <- fluidPage(theme = shinytheme("darkly"),
# Application title
titlePanel("Perceptual Map Dashboard"),
sidebarLayout(
# Sidebar with a slider and selection inputs
sidebarPanel(
#Excel doc row and column names
numericInput(inputId="startcol",label="Input start column of CSV file:",value="", min=1,max=10000),
numericInput(inputId="endcol",label="Input end column of CSV file:",value="", min=1,max=10000),
#Inputing brands and emotions
br(),
numericInput(inputId = "rownums",label = "How many emotions/characteristics are you evaluating?",value = "", min = 1,max = 10000),
br(),
h6("Note: Please enter brands and emotions/characteristics in the order that they appear in the excel document exported from Survey Gizmo."),
textInput ( 'brands', 'List the brands included in your perceptual map (separated by commas):', value=""),
textInput ( 'emotions', 'List the emotions/characteristics included in your perceptual map (separated by commas):', value=""),
#Removing brands and emotions
#Select graph type
textInput(inputId="plottitle",label="Title your graph:"),
#Upload Excel Grid
fileInput(inputId = 'data', 'Upload CSV File',
accept=c('.csv')),
actionButton("go","Create Map")
),
# Visual Output
mainPanel(
wellPanel(h4('Visual'),
h5("Once your visual appears, just right click it to save it as a .png file.")),
plotOutput(outputId = "plot", width = "100%", height=500)
# downloadButton("downloadPlot", "Download Visual")
)
)
)
server <- function(input,output){
K <- eventReactive(input$go,{
x <- read.csv(input$data$datapath, header = F)
x[!is.na(x)] <- 1
x[is.na(x)] <- 0
x<-x[,as.numeric(input$startcol):as.numeric(input$endcol)]
column.sums<-colSums(x)
print(column.sums)
pmd.matrix<-matrix(column.sums, byrow = T, nrow=as.numeric(input$rownums))
pmd.df2<-as.data.frame(pmd.matrix)
colnames(pmd.df2) = unlist(strsplit(as.character(input$brands),","))
print(pmd.df2)
row.names(pmd.df2)= unlist(strsplit(as.character(input$emotions),","))
print(pmd.df2)
pmd.df2[-nrow(pmd.df2),]
print(pmd.df2)
fit <- CA(pmd.df2, graph=F)
return(fit)
})
p <- eventReactive(input$go,{
input$plottitle
})
output$plot<- renderPlot({
plot.CA(K(), col.row = "blue", col.col="black", cex=1, new.plot=T,
title=p())
})
}
shinyApp(ui = ui, server = server)
What I suggest to you is to check whether this issue is specific to your plot or if plot.CA is not working with shiny in general. Try to "deploy" (apparently, you don't use a webserver?) the following app
library(FactoMineR)
library(shiny)
data(children)
res.ca <- CA(children, col.sup = 6:8, row.sup = 15:18)
shinyApp(
fluidPage(plotOutput("plot")),
function(input, output, sesison) {
output$plot <- renderPlot({
plot.CA(res.ca)
})
}
)
If this does work, there might be something wrong with your model or maybe there are name collusions between the ca package and the FactorMineR package.
If this does not work, try the following instead
## use same data/libraries as above
myfile <- tempfile(fileext = ".png")
shinyApp(
fluidPage(imageOutput("plot")),
function(input, output, sesison) {
output$plot <- renderImage({
png(file = myfile)
plot.CA(res.ca)
dev.off()
list(src = myfile)
}, deleteFile = FALSE)
}
)
And see
Whether the app works now
Whether myfile gets created and contains reasonable contents.
I am creating a shiny dashboard wherein I need to dynamically update information based on an option in a drop down box.
My question is 1. can this be done, and if so: how?
I have created my drop down menu, which works fine, from there I want to same something along the lines of "if outlet xyz is picked, update charts with unique information"
Code thus far:
output$Box1 = renderUI(
selectInput("Outlets",
"Select an Outlet",
c("Start Typing Outlet
Name",as.character(unique(outlets$Outlets))),
"selectoutlet"))
once the outlet has been selected, I want the data in my R script to only update for that one outlet.
As You havent supplied reproducible example, here is the code with mtcars dataset:
library(shiny)
library(dplyr)
library(ggplot2)
ui= fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId= "cyl", label= "cyl",
choices= unique(mtcars$cyl),
selected= sort(unique(mtcars$cyl))[1],
multiple=F)
),
mainPanel(
plotOutput("plot")
)
)
)
server= function(input, output,session) {
df_filtered <-reactive({
data <- mtcars %>% {if (is.null(input$cyl)) . else filter(., cyl %in% input$cyl)} # here is the reactive dataset which You can further use it in table or in the plot
print(data)
data
})
output$plot <- renderPlot({
ggplot(data = df_filtered(), aes(x=cyl,y=mpg)) + geom_point(size=5) # as You can see i have used data = df_filtered()
})
}
shinyApp(ui, server)
Have a look at the comments in the code to get some better idea how it works.
I have a UI test that checks the value of static text element, waits a few seconds and checks again to confirm a change. At first it wasn't working because the hierarchy was not updating. I noticed this in the log;
Use cached accessibility hierarchy for
I've put in a workaround for this by simply adding a tap to a menu and opening/closing it so that an event is synthesized and the hierarchy is updated.
It would be better, however, if there was a way to clear the cache directly or force and update. I haven't found one in the API. Am I missing something?
Any ideas?
this is what I am doing;
XCTAssertEqual(app.staticTexts["myText"].label, "Expected 1")
sleep(20)
menu.tap()
sleep(1)
menu.tap()
XCTAssertEqual(app.staticTexts["myText"].label, "Expected 2")
What I'd like to be able to do it
XCTAssertEqual(app.staticTexts["myText"].label, "Expected 1")
sleep(20)
app.elements.refresh()
XCTAssertEqual(app.staticTexts["myText"].label, "Expected 2")
In order to force an update of the accessibility hierarchy, request the count property for any XCUIElementQuery:
// refresh
_ = XCUIApplication().navigationBars.count
// examine
print(XCUIApplication().debugDescription)
The above results in: "Get number of matches for: Descendants matching type NavigationBar" and "Snapshot accessibility hierarchy for com.myapp".
The following works for me in Xcode 10.2 (10E125):
import XCTest
extension XCUIApplication {
// WORKAROUND:
// Force XCTest to update its accessibility cache. When accessibility data
// like NSObject.accessibility{Label|Identifier} changes, it takes a while
// for XCTest to catch up. Calling this method causes XCTest to update its
// accessibility cache immediately.
func updateAccessibilityCache() {
_ = try? snapshot()
}
}
You should use expectationForPredicate, along the lines of...
let myText = app.staticTexts["myText"]
let waitFor = NSPredicate(format: "label = 'Expected 2'")
label.tap()
self.expectationForPredicate(waitFor, evaluatedWithObject: myText, handler: nil)
self.waitForExpectationsWithTimeout(2.0, handler: nil)
This will wait until either myText's label is 'Expected 2', or the timeout of 2 seconds is reached.
In my case, it is a problem because I'm trying to test for Facebook login, which uses Safari controller. It looks like Facebook has updated the UI after cache.
So you need to wait a bit, use the wait function here https://stackoverflow.com/a/42222302/1418457
wait(for: 2)
let _ = app.staticTexts.count
But the above is just workaround and very flaky. A more correct approach would be to wait for a certain element to appear, see https://stackoverflow.com/a/44279203/1418457
In my server.R I have:
output$interactive <- renderIHeatmap(...
output$static <- renderPlot(...
Both of these render heatmaps, one interactive, one static. Is there a way that shiny can automatically choose to display the static heatmap if the row or column dimensions of the heatmap is greater than a specific number? So something like...
box(width = NULL, solidHeader = TRUE,
if (heatmap_rows<100) {
iHeatmapOutput('interactive')
} else {
plotOutput('static')
})
Thank you for your time. I apologize if this is unclear.
What you are looking for is conditionalPanel().
In server.R, you need to make an output variable that is the number of rows:
shinyServer(function(input,output,session){
output$heatmap_rows <- renderText(nrow(heatmap_data))
}
In your ui.R, you need to display that output somewhere. You can probably hide it cleverly with .css, but it has to actually go into the html of your page, or else you won't be able to condition on it with conditionalPanel.
So here's the general idea in ui.R:
shinyUI(fluidPage(
mainPanel(
#Note the output.heatmap_rows syntax. That's JavaScript.
conditionalPanel("output.heatmap_rows < 100",
iHeatmapOutput('interactive')
),
conditionalPanel("output.heatmap_rows >= 100",
plotOutput('static')
)
),
#This has to be somewhere on the page, and it has to render.
#Alter the css and make its' text the same color as the background.
verbatimTextOutput("heatmap_rows")
))
I haven't found a better way to condition on data from the output. You could probably hide all of that logic behind a uiRender in server.R as well.