I'm trying to shift elements out of the way for rendered images not to overlap with anything (trying to do it dynamically so that any size page fits and just pushed everything out of the way sort of)... Pretty new to this whole thing. Thank you in advance!
library(shiny)
library(webshot)
ui <- fluidPage(
titlePanel(
fluidRow ( align = "center", h3("Screens"))
),
sidebarLayout(
#Side panel lay out to include variant, gene and disease info relevant to interpretation
sidebarPanel(width=3,
h5("Screens")),
mainPanel(
textInput("screen1", h5("Screenshot1"),
value = "http://example.com/", width = "100%", placeholder = NULL),
imageOutput("screen1"),
textInput("screen2", h5("Screenshot2"),
value = "http://example.com/", width = "100%", placeholder = NULL),
imageOutput("screen2")
)))
server <- function(input, output, session) {
output$screen1 <- renderImage({
webshot(input$screen1, zoom = 1,
file = "screen1.png")
list(src = "screen1.png",
contentType = 'image/png')
})
output$screen2 <- renderImage({
webshot(input$screen2 , zoom = 1,
file = "screen2.png")
list(src = "screen2.png",
contentType = 'image/png')
})
}
shinyApp(ui = ui, server = server)
Related
I am building a shiny dashboard and plan to use SliderInput to animate a set of exisiting pngs. To do so, in the UI I have:
tabItem(tabName = 'Image',
fluidRow(
box(title = "", status="primary",solidHeader = F,width = 9,
uiOutput("animate_img"),
tags$style(type="text/css", "recalculating { opacity: 1.0 !important; }") # NOT WORKING
),
box(
title = "Options", status="info",solidHeader = TRUE,width = 3,
sliderInput("dates_img",
"Dates:",
min = as.Date("2017-01-01","%Y-%m-%d"),
max = as.Date("2018-12-31","%Y-%m-%d"),
value=as.Date("2017-01-01"),
timeFormat="%Y-%m-%d",
animate=animationOptions(interval=1000, loop = TRUE))
)
)
)
and in the server I have:
output$animate_img <- renderUI({
y <- year(input$dates_img)
d <- yday(input$dates_img)
filename <- sprintf("img_%d_%d.png",d,y)
tags$img(src = filename, width="100%")
})
While this code works to display the images, when I use the "play" button on the sliderInput to animate the images, there is flickering as each image loads. I would like to have a smooth animation if possible.
As suggested here, I have tried adding tags$style(type="text/css", "recalculating { opacity: 1.0 !important; }") to the UI, but this does not work.
Any recommendations for how to prevent the images from flickering as the animation plays? Thank you!
I was able to get it to work without any flickering by simply adjusting how the CSS is included in the rendered HTML. I used shinyjs::inlineCSS in my example, but the same could be done via sourcing an external stylesheet .css file with tags$head and tags$script or via includeCSS, etc. The key is to have the CSS loaded into the full HTML document's head (can verify via browser DevTools):
library(shiny)
library(shinydashboard)
library(shinyjs)
library(lubridate)
ui <- fluidPage(
shinyjs::inlineCSS(
"recalculating { opacity: 1.0 !important; }"
),
fluidRow(
box(title = "",
status = "primary",
solidHeader = F,
width = 9,
uiOutput("animate_img")
),
box(
title = "Options",
status = "info",
solidHeader = TRUE,
width = 3,
sliderInput("dates_img",
"Dates:",
min = as.Date("2017-01-01","%Y-%m-%d"),
max = as.Date("2018-12-31","%Y-%m-%d"),
value = as.Date("2017-01-01"),
timeFormat = "%Y-%m-%d",
animate = animationOptions(interval = 1000, loop = TRUE))
)
)
)
server <- function(input, output) {
output$animate_img <- renderUI({
y <- year(input$dates_img)
d <- yday(input$dates_img)
filename <- sprintf("img_%d_%d.png",d,y)
tags$img(src = filename, width="100%")
})
}
shinyApp(ui = ui, server = server)
Just make sure that your image files are placed directly in the www folder and it should work.
Thanks,
Jimmy
I am making an app in shiny and I want the main panel to occupy 100% of the screen, how can I achieve this? In this occasion I am showing a table but I would also like to add a graph so that it can be seen large.
Below I show the code I am using
screen shiny
library(shiny)
library(DT)
shinyUI(fluidPage(
# Application title
titlePanel("Company-Feature Chart"),
mainPanel(
uiOutput("seleccione_col1"),
uiOutput("seleccione_col2"),
DT::dataTableOutput(outputId =
"diagram")
)
)
)
shinyServer(function(input, output) {
datachart <- read.csv("examplechart1.csv", row.names=1, sep=";")
output$seleccione_col1<- renderUI({
selectInput(inputId="columnaD", (("Product")),
choices =names(datachart),
selected = names(datachart)[c(1,2)],multiple = TRUE)
})
output$seleccione_col2<- renderUI({
selectInput(inputId="columnaE", (("Features")),
choices =row.names(datachart),
selected = row.names(datachart)[1],multiple = TRUE)
})
output$diagram<- renderDataTable({
req(input$columnaE)
data <-datachart[input$columnaE,input$columnaD]
DT::datatable(data, escape = FALSE,options = list(sDom = '<"top">lrt<"bottom">ip',lengthChange = FALSE))
}, rownames = TRUE)
})
Use the width option:
mainPanel(
uiOutput("seleccione_col1"),
uiOutput("seleccione_col2"),
DT::dataTableOutput(outputId = "diagram"),
width = 12
)
I would like to put an action button, to zoom and enlarge image on my shiny app. See the code below, the shiny app render two images "space_1.jpg" and "space_2.jpg" (already created), according to the choice of the user. The idea would be to allow the user the user to enlarge image in a popup window. I don't know how to make it possible. Many thanks for your help,
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
sidebarPanel(width=6,
radioButtons("choice", label = h4("Choose"),choices = c("space_1","space_2"), selected = "space_1"),
dropdown(downloadButton(outputId = "down_image_test",label = "Download plot"),size = "xs",icon = icon("download", class = "opt"), up = TRUE),
actionBttn(inputId = "zoom_image_test",icon = icon("search-plus", class = "opt"),style = "fill",color = "danger",size = "xs")
),
mainPanel(h2("main panel"),imageOutput('image_test'))
)
server <- function(input, output){
output$image_test <- renderImage({
nam=paste0(getwd(),"/",input$choice,".jpg")
list(src = nam,height = 200)}, deleteFile = FALSE)
output$down_image_test <- downloadHandler(
filename = "test.jpg",
content = function(file) {
nam=paste0(getwd(),"/",input$choice,".jpg")
file.copy(nam, file)
})
}
shinyApp(ui,server)
Aim: divide the available tabPanel into equal cells and display images in cells with Shiny, the number of cells in horizontal space (columns) can be inputted and changed by selectInput. As the number of columns changes, so does the sizes of grids and images.
Problem: how to change the (horizontal and vertical) spacing between cells? how to resize images to fit cells? how to load and display hundreds of images more efficiently with Shiny? Thank you in advance!
Below is the code adapted from this and this, which can display images, but has some problems mentioned before.
rm(list = ls())
library(shiny)
img_dirs <- list.files("www/image", full.names = TRUE)
# img_dirs <- img_dirs[1:10]
img_num <- length(img_dirs)
render_image <- function(img_num, input, output) {
for (i in seq.int(img_num)) {
local({
ii <- i
output[[paste0("img_", ii)]] <- renderImage({
list(src = img_dirs[ii],
contentType = 'image/jpg',
width = '50%',
height = 'auto',
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
}
ui <- shinyUI(
navbarPage(
theme = shinythemes::shinytheme("cerulean"),
title = "UU",
tabPanel('images',
sidebarPanel(
selectInput('col_num', 'Columns', c(1, 2, 3, 4, 6, 12), selected = 4)),
mainPanel(
uiOutput('myplots'))
)
)
)
server <- shinyServer(function(input, output) {
output$myplots <- renderUI({
## Construct imageOutputs
img_out_lst <- lapply(seq.int(img_num), function(i)
imageOutput(paste0('img_', i)))
fluidRow(
lapply(
split(img_out_lst, f = rep(c(1 : as.numeric(input$col_num)), length.out = length(img_out_lst))),
function(x) column(width = 12 / as.numeric(input$col_num), x, offset = 0, align="center",
style = "padding: 0px 0px; margin-top:-2em")) # fail to decrease spacing
)
})
observeEvent(img_num, render_image(img_num, input, output))
})
shinyApp(ui, server)
I can't correctly position the length changing and the filtering input to the top-right and bottom-left respectively on my DT::datatable output in shiny using the dom option. Code:
library(shiny)
library(DT)
set.seed(2282018)
company <- data.frame(Company = letters[1:10], Sales = scales::dollar(runif(10, 200, 1230)), stringsAsFactors = F)
# UI ----
ui <- function(){
fluidPage(
sidebarLayout(
sidebarPanel(numericInput("nums", label = "Num Input", value = 1, min = 1, max = 10)),
mainPanel(dataTableOutput("mytable"))
)
)
}
# server ----
server <- function(input, output, session){
output$mytable <- renderDataTable({
datatable(company,
caption = tags$caption("StackOverflow Example"),
filter = "none",
options = list(
autoWidth = T,
pageLength = 10,
scrollCollapse = T,
dom = '<"right"l>t<"left"f>')
)
})
}
runApp(list(ui = ui, server = server))
As stated before, my goal is to move l to the top right and f to the bottom left.
Thanks!
Process
In the DataTable DOM positioning reference, there are examples of moving elements to top/bottom, but not left/right. I'm not sure if moving elements left/right is possible using just the dom option.
However, per this question about moving the search box, you can move the elements left/right in three steps:
Make CSS classes
css <- HTML(".pull-left{float: left !important;}
.pull-right{float: right !important;}")
Use javascript/jQuery to add the classes to your datatable
js <- HTML("$(function(){
setTimeout(function(){
$('.dataTables_filter').addClass('pull-left');
$('.dataTables_length').addClass('pull-right');
}, 200);
});")
Add the CSS and JS to the HTML header of your shiny app
fluidPage(
tags$head(tags$style(css),
tags$script(js)),
...)
Full example
library(shiny)
library(DT)
set.seed(2282018)
company <- data.frame(Company = letters[1:10], Sales = scales::dollar(runif(10, 200, 1230)), stringsAsFactors = F)
css <- HTML(".pull-left{float: left !important;}
.pull-right{float: right !important;}")
js <- HTML("$(function(){
setTimeout(function(){
$('.dataTables_filter').addClass('pull-left');
$('.dataTables_length').addClass('pull-right');
}, 200);
});")
# UI ----
ui <- function(){
fluidPage(
tags$head(tags$style(css),
tags$script(js)),
sidebarLayout(
sidebarPanel(numericInput("nums", label = "Num Input", value = 1, min = 1, max = 10)),
mainPanel(dataTableOutput("mytable"))
)
)
}
# server ----
server <- function(input, output, session){
output$mytable <- renderDataTable({
datatable(company,
caption = tags$caption("StackOverflow Example"),
filter = "none",
options = list(
autoWidth = T,
pageLength = 10,
scrollCollapse = T,
dom = '<"top"l>t<"bottom"f>')
)
})
}
runApp(list(ui = ui, server = server))