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.
Related
I am trying to create a shiny app to render the 3d point cloud, but I am not sure where to start. Can anyone please help with an example?
Tried the following code but it is giving me pop up
library(shiny)
library(lidR)
library(rlang)
library(rgl)
library(ggplot2)
library(rglwidget)
las<-readLAS("S://change_detction//Snow_on//points (6).las")
str(las)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("LiDAR Visualisation"),
# Sidebar with a slider input for number of bins
rglwidgetOutput("plot", width = 800, height = 600)
# Show a plot of the generated distribution
#mainPanel(
#rglwidgetOutput("distPlot",width = 300, height = 300)
)
# Define server logic required to draw a histogram
server <- function(input, output,session) {
output$plot<- renderRglwidget({
rgl.open()
# generate bins based on input$bins from ui.R
plot(las)
rglwidget()
})
}
# Run the application
shinyApp(ui = ui, server = server)
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)
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 trying to build an Rshiny app which requires a tree like structure to be displayed. For this, I am using package called collapsibleTree in R. Tree displayed using this package is in horizontal direction, But, I am just curious, if there is a way to display it in vertical direction? I went through their documentation but couldn't find any.
Below, is the reproducible code. Also, I am using bsModal for the tree to be displayed on a popup window, the alternate way I am thinking of changing the orientation of popup (From horizontal to vertical, not really sure, if the same can be achieved).
library(shiny)
library(collapsibleTree)
# Define UI for application that draws a collapsible tree
ui <- fluidPage(
# Application title
titlePanel("Collapsible Tree Example 2: Shiny Interaction"),
# Show a tree diagram with the selected root node
mainPanel(
collapsibleTreeOutput("plot")
)
)
)
# Define server logic required to draw a collapsible tree diagram
server <- function(input, output) {
output$plot <- renderCollapsibleTree({
hierarchy <- c("wool","tension","breaks")
collapsibleTree(
warpbreaks, hierarchy
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
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.