I am trying to make an app that allow user to input data and then let shiny server to calculate some results, for example, I could make shiny generate a plot or a data table.
However, due to the space of the UI, I kind of "run out of" space. The input box, and documentation of the app take a whole screen. And when the shiny generate the results it will show at the very bottom of the screen.
Is there a way that I can make shiny pop-up a message box to show the result?
My sudo-code would be:
ui <- fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
actionButton("demo", "Fill in fields with demo"))
server <- function(input, output, session) {
observeEvent(input$demo, {
****************************
OpenNewPage/MoveScreenDown()
****************************
updateTextInput(session, "text", value = H)
updateNumericInput(session, "age", value = "30")
})}
When clicking the "demo", a message box popup or I can make the screen move to the result part and allow the text to be at the top of the screen.
There are options to show your results in a separated window. But maybe will be easier to have everything on the same window.
You can use the shinyBS library to create a modal window to show the plot. Another option is to use JavaScript to move the scroll to the bottom of the page. I put the two options in the following example, so you can see which one is better for you.
library(shiny)
library(shinyBS)
runApp(list(
ui = shinyUI(fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
# option 1, using ShinyBS with a modal window
actionButton("demo", "Using a modal"),
# modal window to show the plot
bsModal("largeModalID","Results", "demo", size = "large", plotOutput('plot')),
# Option 2, action button with a JavaScript function to move the scroll to the bottom
# after drawing the plot.
actionButton("demoJS", "Using JS",
# there is a delay to allow the renderPlot to draw the plot and you should
# change it according to the processes performed
onclick = "setTimeout( function() {
$('html, body').scrollTop( $(document).height() );},
300)"),
# to plot the results after click on "Using JS"
uiOutput("plotUI")
)
),
server = shinyServer(function(input, output, session) {
output$plot <- renderPlot({
# simple plot to show
plot(sin, -pi, 2*pi)
})
output$plotUI <- renderUI({
# this UI will show a plot only if "Using JS" is clicked
if (input$demoJS > 0)
# the margin-top attribute is just to put the plot lower in the page
div(style = "margin-top:800px", plotOutput('plot2'))
})
output$plot2 <- renderPlot({
# another simple plot,
plot(sin, -pi, 2*pi)
})
})
))
If you think that the JavaScript option works better for you, you could consider start using the shinyjs library, it includes very useful functions and you can easily add your own JavaScript code to your Shiny Apps.
Related
Trying to finish my shiny app, I couldn't find a way to remove the scroll bar (the scroll bar isn't intended and I didn't actively choose it via code)
When I'm running the files individually I don't have the problem with the scroll bars. They only appear in the whole app.
Code for the whole app:
library(shiny)
library(shinythemes)
ui = navbarPage("Cohen's D",
theme = shinytheme("cerulean"),
tabPanel("What's Cohen's D?",
withMathJax(includeMarkdown("about.Rmd"))),
tabPanel("Calculate with statistics",
source("CohenDplusVisual.r")[1]
),
tabPanel("Upload your data frame",
source("CohenD_OwnDATA.r")[1]
),
)
server = function(input, output) {
}
shinyApp(ui, server)enter image description here
Again, if somebody could help me out, I would be extremely thankfulenter image description here
You can hide scrollbars for any div with the CSS overflow property. Here is a reproducible example for your navbarPage situation. Here we place it in an extra tagList so we can put the CSS somewhere (navbarPage does not have a style argument or another way to add extra CSS).
library(shiny)
ui <- tagList(
tags$head(tags$style("body{overflow:hidden;}")),
navbarPage(title = "Test page",
tabPanel("Tab1",
tags$div(style = "height: 2000px; background-color:grey;"))
)
)
server <- function(input, output, session){}
shinyApp(ui,server)
I am building a shiny app and I am using two sidebarLayouts. I’m looking for a way to minimize them. I have try put each sidebarLayout into a box.
Example code:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
headerPanel("Here goes the heder"),
box(sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs"))),
width = 12,
title = "BB",
collapsible = T,
collapsed = F
)
)
server <- function(input, output) {
output$someinputs <- renderText({
"Here will go the inputs"
})
output$someoutputs <- renderText({
"Here will go the outputs"
})
}
shinyApp(ui, server)
Output:
When I press the collapsible button the Layout does not collapse. Why is this happening? What should I do? Is there other way to do this?
Because you didn't use shinydashboard. The box comes from shinydashboard package. You need to use shinydashboard::dashboardPage instead of fluidPage.
dashboardPage Loads required javascripts and CSS files to toggle the button.
library(shiny)
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(),
shinydashboard::dashboardSidebar(),
shinydashboard::dashboardBody(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)
)
)
If you don't want to use dashboardPage, you can write your own scripts to control the button:
library(magrittr)
library(shiny)
ui <- fluidPage(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)%>% {.$attribs[['id']] <- 'example-box'; .},
tags$head(tags$script(
"$(document).ready(function(){
$('#example-box button').attr({
'data-toggle':'collapse',
'data-target':'#example-box .box-body',
'aria-expanded':false
})
})"
))
)
I used a hack to assign an ID to the box %>% {.$attribs[['id']] <- 'example-box'; .}, and use some jquery to control the button. Be sure the ID in the script matches the ID you assign in UI, example-box in this case. In javascript, you add # for ID searching, so #example-box.
I wouldn't recommend you to use the second way. You can see in your UI, it's not really a box. It has no border and the button is not at the right place. If you use dashboardPage, you can see the difference.
I am building an app with RShiny that renders a pdf as a PNG image which is then shown via a call to imageOutput (If needed, the image can be rendered via a different output, such as plotOutput).
I would like the user to be able to mouse-over or hover over the image to show a larger, more zoomed in version or subset of that same image (Example below).
Is there a way to accomplish this in Shiny?
Thank you
Here is an attempt based on w3schools:
library(shiny)
ui <- fluidPage(
uiOutput('image'),
tags$style('div#image:hover {
transform: scale(1.5);
transform-origin: top left;
}')
)
server <- function(input, output, session) {
output$image <- renderUI({
tags$img(src = 'https://i.stack.imgur.com/dlaci.jpg', width = 400)
})
}
shinyApp(ui, server)
Please play around with transform and transform-origin to suit your needs.
When using a leaflet map inside a draggable Shiny panel (e.g. absolutePanel with draggable=T), panning the leaflet map with the mouse also drags the Shiny panel.
Is there a way to prevent panning the map with the mouse from also moving the Shiny panel?
I think it is similar to this resolved issue:
https://github.com/rstudio/shiny/issues/711
and there are DOM event functions related to click propagation in leaflet.
Edit:
This also occurs with Plotly plots and may be a more general issue than I initially realized. The question has been edited to include plotly.
Leaflet example:
library(leaflet)
library(shiny)
shinyApp(
ui = fluidPage(
absolutePanel(draggable=T, width='600px', wellPanel(
fluidRow(leafletOutput('map'))
))
),
server = function(input, output, session) {
output$map=renderLeaflet({
leaflet() %>%
addProviderTiles(providers$OpenStreetMap)
})
}
)
Setting the dragging option to F in leaflet resolves the problem, but makes the map less useful.
shinyApp(
ui = fluidPage(
absolutePanel(draggable=T, width='600px', wellPanel(
fluidRow(leafletOutput('map'))
))
),
server = function(input, output, session) {
output$map=renderLeaflet({
leaflet(options=leafletOptions(dragging=F)) %>%
addProviderTiles(providers$OpenStreetMap)
})
}
)
Plotly example
Zoom, pan, and select plot interactions all cause the draggable panel to move.
library(plotly)
library(shiny)
shinyApp(
ui = fluidPage(
absolutePanel(draggable=T, width='600px', wellPanel(
fluidRow(plotlyOutput('plot'))
))
),
server = function(input, output, session) {
output$plot=renderPlotly({
plot_ly(data=mtcars, type='scatter', mode='markers', x=~hp, y=~mpg, name=~cyl)
})
}
)
I am very new to programming in R/Shiny: I'll try my best to state my question precisely.
The app below is a simple app of choice between two alternatives. In the app, option A updates every time that one clicks on one of the action buttons, while option B stays fixed.
What I am trying to do is to disable both action buttons after each time that the plot is updated, to "force" the user to stare at the two updated alternatives for at least a minimum number of seconds (in the code below, 3).
Since the plot updates every time one clicks on an action button, I have tried using Sys.sleep(3) between the disable and enable functions (in the shinyjs package) inside observeEvent(input$action2_pe,...) and observeEvent(input$action1_pe,...) but this only invalidates both buttons while the plot is still updating, so that as a result the buttons get disabled and then enabled again only before the plot gets updated.
Another equivalent attempt (code below) has been using Sys.sleep(3) between the disable and enable functions inside observe({output$plotA=renderPlot({...}) and observe({output$plotB=renderPlot({...}) but the same result as above obtains (i.e. it disables and enables the button before showing the updated plot).
Any idea/suggestion on how to get to disable and then enable again the buttons only after the plot gets updated each time?
Thank you in advance for your help!
library(shinyjs)
library(shiny)
ui <- fluidPage(id="main",title="Example disable-enable actionbutton after plotoutput update",
shinyjs::useShinyjs(),
fluidRow(wellPanel(
splitLayout(cellWidths = c("50%", "50%"),
column(12,align="center",
plotOutput("plotA",width="100%"),
actionButton("buttonA", label = "Choice A")),
column(12,align="center",
plotOutput("plotB",width="100%"),
actionButton("buttonB", label = "Choice B")
)))))
server <- function(input, output, session) {
rv=reactiveValues()
range=10
######
s_data=data.frame(X2=c(500,400,300,200,100), Y2=c(0,0,0,0,0))
q=1
m=dim(s_data)[1]
s_data=s_data[sample(1:m,m),]
rv$X2=s_data[q,"X2"];
rv$Y2=s_data[q,"Y2"];
observe({rv$pres=0.5*(rv$X2 + rv$Y2)})
observe({rv$dmin=rv$Y2 ; rv$dmax=rv$X2})
rv$q=1
####
fun=function(a1,b1,c1){
totlength=100
plot(NA,xlim=c(-10,totlength),ylim=c(0,10),
axes=F,xlab="",ylab="")
if (b1>a1){
text(45,0,paste("Adopt", round(c1,digits=0), "cats" ,"in", 2 , "days"))
}
if (a1>b1){
text(45,0,paste("Adopt", rv$X2, "cats" ,"in", 10 , "years"))
}
}
####
step_pe=reactive((rv$dmax-rv$dmin)<=range)
observe({output$plotA=renderPlot({
par(fig = c(0,1,0,1))
fun(1,2,rv$pres)
shinyjs::disable("buttonA")
shinyjs::disable("buttonB")
Sys.sleep(3)
shinyjs::enable("buttonA")
shinyjs::enable("buttonB")
})})
observe({output$plotB=renderPlot({
par(fig = c(0,1,0,1))
fun(2,1,rv$pres)
shinyjs::disable("buttonA")
shinyjs::disable("buttonB")
Sys.sleep(3)
shinyjs::enable("buttonA")
shinyjs::enable("buttonB")
})})
observeEvent(input$buttonA,{
if(!step_pe()){
rv$dmax=rv$pres
temp1=round(0.5*(rv$dmin+rv$pres)/range)
rv$pres=range*temp1
}
})
observeEvent(input$buttonB,{
if (!step_pe()){
rv$dmin=rv$pres
temp1=round(0.5*(rv$dmax+rv$pres)/range)
rv$pres=range*temp1
}
})
}
shinyApp(ui = ui, server = server)