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.
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 have a fair understanding of Shiny and R but I'm just getting started with Javascript and have never coded in HTML or CSS. I would like to learn to build a collapsible tree using D3.js ( Something like this) Is there any tutorial that I can refer to get started with integrating D3.js into Shiny?
I have come across the CollapsibeTree package but I would like to learn how to build one myself. Any help would be highly appreciated!
here is the minimap example using the diamonds dataset. You can find more examples here https://github.com/AdeelK93/collapsibleTree
library(shiny)
#install.packages("collapsibleTree")
library(collapsibleTree)
data(diamonds,package = "ggplot2")
subdiamonds <- diamonds[1:300,]
ui <- fluidPage(
mainPanel(
collapsibleTreeOutput("tree")
)
)
server <- function(input, output, session) {
output$tree <- renderCollapsibleTree({
collapsibleTree(
subdiamonds,
hierarchy = c("cut", "color","price"),
width = 800
)
})
}
shinyApp(ui = ui, server = server)
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")})
})
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.