Images Don't Display in Rshiny - image

images don't display correctly (empty image displays) in R shiny, both internal as external (app.R) runs
similar questions posted in the past on this site do not provide an adequate answer: the solution of running the application through app.R doesn't solve the problem for me, image still isn't displayed
in the code: image is added to the main panel , both tried from documents as from web (converting images to web link).
example image: https://ibb.co/Bt6v6W9
I tried both to include the image through documents (local working directory) as by converting the image to a web link.
how the output looks: https://cdn1.imggmi.com/uploads/2019/4/24/d65ae8a21decc6adb1d14db9a3e9bf75-full.png
Anyone an idea for solution? As mentioned, running the application through app.R doesn't work, output remains the same.
library(shiny)
library(png)
# See above for the definitions of ui and server
library(shiny)
library(png)
# Define UI for app that draws a histogram ----
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Slider for the number of bins ----
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Histogram ----
plotOutput(outputId = "distPlot"),
img(src='DataVIS1.png', align = "right",height=168,width=70)
##output: png image
)
)
)
server <- function(input, output) {
# Histogram of the Old Faithful Geyser Data ----
# with requested number of bins
# This expression that generates a histogram is wrapped in a call
# to renderPlot to indicate that:
#
# 1. It is "reactive" and therefore should be automatically
# re-executed when inputs (input$bins) change
# 2. Its output type is a plot
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui = ui, server = server
)

You should throw the code that creates the image in the server side, encapsulate it inside a a renderPlot({}) function that you've named, then plot the output just after the "distPlot" plotOutput. I couldn't get your img(src=...) code to work so I used a raster plot which is functionally the same for this purpose. A minified example is as follows:
library(shiny)
library(png)
ui <- fluidPage(
mainPanel(
plotOutput(outputId = "png")
)
)
server <- function(input, output) {
output$png <- renderPlot({
pic = readPNG('path/to/image.png')
plot.new()
grid::grid.raster(pic)
})
}
shinyApp(ui = ui, server = server)
Putting this into your code yields:
library(shiny)
library(png)
# See above for the definitions of ui and server
library(shiny)
library(png)
# Define UI for app that draws a histogram ----
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Slider for the number of bins ----
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Histogram ----
plotOutput(outputId = "distPlot"),
###Changed code here
plotOutput(outputId = "png")
##output: png image
)
)
)
server <- function(input, output) {
# Histogram of the Old Faithful Geyser Data ----
# with requested number of bins
# This expression that generates a histogram is wrapped in a call
# to renderPlot to indicate that:
#
# 1. It is "reactive" and therefore should be automatically
# re-executed when inputs (input$bins) change
# 2. Its output type is a plot
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
###New function
output$png <- renderPlot({
pic = readPNG('path/to/image.png')
plot.new()
grid::grid.raster(pic)
})
}
shinyApp(ui = ui, server = server
)
... And displays:

Related

Interacting with sg.image on a clic or a mouse fly over

I made a code using pysimplegui. it basically shows some images from a database based on a scanned number. it works but sometimes it could be useful to be able to increase the size of the image + it would make my user interface a bit more interactive
i want to have the possibility to either:
when i fly over the image with the mouse, i want the image to increase in size
have the possibility to clic on the image and have a pop-up of the image showing up (in a bigger size)
i am not sure on how to interact with a sg.image()
Below you will find a trunkated part of my code where i show my way of getting the image to show up.
layout = [
[
sg.Text("Numéro de boîte"),
sg.Input(size=(25, 1), key="-FILE-"),
sg.Button("Load Image"),
sg.Button("Update DATA"),
sg.Text("<- useless text ")
],
[sg.Text("Indicateur au max" , size = (120, 1),font = ("Arial", 18), justification = "center")],
[sg.Image(key="-ALV1-"),sg.Image(key="-ALV2-"), sg.Image(key="-ALV3-"), sg.Image(key="-ALV4-"), sg.Image(key="-ALV5-")],
[sg.Image(key="-ALV6-"),sg.Image(key="-ALV7-"), sg.Image(key="-ALV8-"), sg.Image(key="-ALV9-"), sg.Image(key="-ALV10-")],
[sg.Text("_" * 350, size = (120, 1), justification = "center")],
[sg.Text("Indicateur au milieu" , size = (120, 1),font = ("Arial", 18), justification = "center")],
[sg.Image(key="-ALV11-"),sg.Image(key="-ALV12-"), sg.Image(key="-ALV13-"), sg.Image(key="-ALV14-"), sg.Image(key="-ALV15-")],
[sg.Image(key="-ALV16-"),sg.Image(key="-ALV17-"), sg.Image(key="-ALV18-"), sg.Image(key="-ALV19-"), sg.Image(key="-ALV20-")],
[sg.Text("↓↓↓ ↓↓↓" , size = (120, 1),font = ("Arial", 18), justification = "center")],
]
ImageAlv1 = Image.open(PathAlv1)
ImageAlv1.thumbnail((250, 250))
bio1 = io.BytesIO()
ImageAlv1.save(bio1, format="PNG")
window["-ALV1-"].update(data=bio1.getvalue())
Using bind method for events, like
"<Enter>", the user moved the mouse pointer into a visible part of an element.
"<Double-1>", specifies two click events happening close together in time.
Using PIL.Image to resize image and io.BytesIO as buffer.
import base64
from io import BytesIO
from PIL import Image
import PySimpleGUI as sg
def resize(image, size=(256, 256)):
imgdata = base64.b64decode(image)
im = Image.open(BytesIO(imgdata))
width, height = size
w, h = im.size
scale = min(width/w, height/h)
new_size = (int(w*scale+0.5), int(h*scale+0.5))
new_im = im.resize(new_size, resample=Image.LANCZOS)
buffer = BytesIO()
new_im.save(buffer, format="PNG")
return buffer.getvalue()
sg.theme('DarkBlue3')
number = 4
column_layout, line = [], []
limit = len(sg.EMOJI_BASE64_HAPPY_LIST) - 1
for i, image in enumerate(sg.EMOJI_BASE64_HAPPY_LIST):
line.append(sg.Image(data=image, size=(64, 64), pad=(1, 1), background_color='#10C000', expand_y=True, key=f'IMAGE {i}'))
if i % number == number-1 or i == limit:
column_layout.append(line)
line = []
layout = [
[sg.Image(size=(256, 256), pad=(0, 0), expand_x=True, background_color='green', key='-IMAGE-'),
sg.Column(column_layout, expand_y=True, pad=(0, 0))],
]
window = sg.Window("Title", layout, margins=(0, 0), finalize=True)
for i in range(limit+1):
window[f'IMAGE {i}'].bind("<Enter>", "") # Binding for Mouse enter sg.Image
#window[f'IMAGE {i}'].bind("<Double-1>", "") # Binding for Mouse double click on sg.Image
element = window['-IMAGE-']
now = None
while True:
event, values = window.read()
if event == sg.WINDOW_CLOSED:
break
elif event.startswith("IMAGE"):
index = int(event.split()[-1])
if index != now:
element.update(data=resize(sg.EMOJI_BASE64_HAPPY_LIST[index]))
now = index
window.close()

Issue with using reset (shinyJS function) and click together and then observing the clicked button

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

When using officer and rvg, can you remove or prevent the background white square behind the image inserted into PowerPoint from the code?

When using officer and the rvg graphics I want my images to not have the background white square.
The reason for this is that some functions leave a lot of empty space up at the top and often this will overlap with the header. I can go in and delete each one but when making 20 or more plots this gets tedious fast.
Specifically I want to use this with the forest function in metafor used here in the example.
Before deleting the background.
**
After deleting the background.
**
library(officer)
doc <- read_pptx()
doc <- add_slide(doc, "Title and Content", "Office Theme")
doc <- ph_with_vg_at(doc, code = barplot(1:5, col = 2:6),
left = 1, top = 2, width = 6, height = 4)
library(metafor)
library(gemtc)
network <-mtc.network(smoking$data.ab)
data(dat.bcg)
plot(network)
res <- rma(ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg, measure="RR",
slab=paste(author, year, sep=", "), method="REML")
forest(res)
doc <- add_slide(doc, "Title and Content", "Office Theme")
doc <- ph_with_vg(doc, code = plot(network), type = "body", width = 8, height = 6)
doc <- add_slide(doc, "Title and Content", "Office Theme")
doc <- ph_with_vg(doc, code = forest(res), type = "body", width = 8, height = 6)
print(doc, target = "vg.pptx")
This is now possible using the latest rvg update and setting the background to "NA".
anyplot = dml(code = barplot(1:5, col = 2:6), bg = "NA")
doc <- read_pptx()
doc <- add_slide(doc)
doc <- ph_with(doc, anyplot, location = ph_location_fullsize())
print(doc, target = "bg.pptx")

plot.CA() renders in shiny app locally but not when app is deployed

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.

Accessing Dynamic Data from Drop down box in Shiny

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.

Resources