Vertical Collapsible Tree in RShiny using collapsibleTree - shiny

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)

Related

How to get rid of an unwanted scroll bar in a shiny app

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)

Creating a mouseover zoom or hover zoom in RShiny

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.

Panning leaflet map or Plotly plot in draggable Shiny panel also moves panel

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)
})
}
)

Q: How to make shiny app output result in a new page?

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.

shiny app only works on specific browsers / platforms

I have programmed a shiny app in RStudio using R version 3.2.4. The app can be found here: https://koenvandenberge.shinyapps.io/tempConditioning/
Note that there is quite a lot of data to be loaded so it takes a couple of seconds to load.
I have deployed it on my Macbook and it seems as if it only works on Safari and Chromium browsers. It does not seem to work on Chrome or Firefox browsers. With this I mean that the plots which should be generated are not. The drop-down menu is present as it should be, so the app does not crash, but the plots that should be generated by selecting something from the drop-down menu do not.
Is there any way to fix this? You can find the code of my app below:
library(shiny)
library(scales)
load("countMatrix.RData")
countMatrixAllSub = as.data.frame(countMatrix$counts[,-1]) ; rm(countMatrix)
sampleNames = unlist(lapply(strsplit(colnames(countMatrixAllSub),split=".",fixed=TRUE), function(x) x[4]))
sampleNames[28] <- "3c0a"
treat=substr(sampleNames,2,2)
time=substr(sampleNames,3,nchar(sampleNames)-1)
timeC=as.numeric(time)
timeC[timeC==15]=0.25
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Gene expression: conditioning experiment Gust"),
# Sidebar with a
sidebarLayout(
sidebarPanel(
selectInput("gene",
"Pick a gene",
choices = rownames(countMatrixAllSub))
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("genePlot")
)
)
))
# Define server logic required to draw an expression plot
server <- shinyServer(function(input, output) {
output$genePlot <- renderPlot({
par(mar = c(5.1, 4.1, 3, 1))
plot(y=countMatrixAllSub[input$gene,],x=timeC, col=c("black","red")[as.numeric(factor(treat))], pch=19,cex=.6,xaxt="n",xlab="Time", ylab="Expression")
lines(x=unique(timeC[!timeC==0]),y=colMeans(sapply(unique(timeC[!timeC==0]), function(t) as.matrix(countMatrixAllSub[input$gene,treat=="c" & timeC==t]))), col=1)
lines(x=unique(timeC[!timeC==0]),y=colMeans(sapply(unique(timeC[!timeC==0]), function(t) as.matrix(countMatrixAllSub[input$gene,treat=="t" & timeC==t]))), col=2)
axis(1,at=c(0,0.25,1,3,6,9),labels=c("","15m","1h","3h","6h","9h"))
abline(v=c(0,0.25,1,3,6,9),col=alpha("grey",.6))
mtext("Conditioned",side=3, adj=0,col="red")
mtext("Unconditioned",side=3, adj=0.2, col="black")
})
})
# Run the application
shinyApp(ui = ui, server = server)