I have a flexdashboard with editable cells in a datatable r_data.
The user can update the cells. I would then like to be able to refer to the updated datatable (updated_df) for further manipulation and save the final result as a file
Is this possible?
Here is MRE:
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(DT)
library(tidyverse)
library(shiny)
```
Column {data-width=500}
-----------------------------------------------------------------------
### Chart A
```{r}
data = head(iris)
r_data = renderDT(datatable(data,
editable = "cell"))
r_data
```
Column {data-width=500}
-----------------------------------------------------------------------
### Chart B
```{r}
updated_df = reactive({
new = r_data()[,1:4]*3
write.csv(new,"new.csv")
})
updated_df
```
Related
I'm trying to create a line chart which is based on filter option along with data table. If I click the filter option it only changed in data table. But I want to set the filters for both Line chart and data table. Kindly help me.
My server.r code is:
output$grp_stacked_bar <- renderPlotly({
data <- ex
agg_sum <- aggregate(data$Result,by=list(Category = data$Donor_ID),FUN=sum, na.rm=TRUE)
p <- plot_ly(
data = agg_sum,
x = ~Category,
y = ~x,
type = "scatter",
mode = "lines+markers"
) %>% layout(title = "Functional Outlier Details", xaxis = list(title = "Donor_ID"),
yaxis = list(title = "Result"))
p
})
ui.r:
column(width = 10,
fluidRow(h2("Function Outlier Details",class="box-title",align="center"),
plotlyOutput(height="48vh",width ="82vw",outputId = "grp_stacked_bar")%>%withSpinner(color="#0dc5c1",hide.ui = FALSE,image.height = "73px",image.width = "145px",image= ".\\logo_gif2.gif"))
)
My sample dataset is:
enter image description here
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:
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.
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.
I am unable to compile PDF using RMarkdown, the waffle package, and glyphs
It doesn't matter if I use the TIKZ device or PDF rendering. The document compiles without a problem to HTML.
The only work around I can think of right now is to create SVG graphic with the HTML compiler, then to reference those files in my intermediate .TEX file.
Notice that if you simply run the code below the line that says, " ## ---- waffle_figure ---- ". It should create the chart given that you've previously installed the fontawesome font on your system, installed the extrafont package in R, and run the font_install() command.
---
title: "Waffle"
output:
pdf_document:
latex_engine: xelatex
html_document: default
header-includes:
- \usepackage{fontspec}
- \defaultfontfeatures{Extension = .otf}
- \usepackage{fontawesome}
- \usepackage{tikz}
---
```{r setup, include=FALSE}
library(knitr)
library(tikzDevice)
knitr::opts_chunk$set(warning = FALSE, error = FALSE, message = FALSE, results='hide', echo = FALSE, dev = "tikz", external = TRUE)
```
\faTwitter
## Waffle Plot
You can also embed plots, for example: \newline
```{r pressure, echo=FALSE, dev="tikz"}
## ---- waffle_figure ----
loadpackages <- function(package.list = c("ggplot2", "Rcpp")) {
new.packages <- package.list[!(package.list %in% installed.packages()[,"Package"])]
if (length(new.packages)){install.packages(new.packages, repos = 'http://cran.us.r-project.org')}
lapply(eval(package.list), require, character.only = TRUE)}
loadpackages(c("waffle", "extrafont", "grid", "gridExtra", "tikzDevice"))
parts <- c(40, 30, 20, 10)
waffle(parts,
rows=10,
use_glyph = "user",
glyph_size = 5)
```
The Waffle package is now updated! Now, both the quartz and cairo devices work with knitr/rmarkdown. Huge thank you's are due to Bob Rudis and Dave Gandy.
The revised code includes latin modern (LaTeX) font in order to demonstrate that it is possible to implement latex fonts alongside fontawesome glyphs in waffle charts.
In order for the code to work, you must first install lmroman10-regular-webfont.ttf and fontawesome-webfont.ttf from their respective websites: Click on the webfont kit link and Fontawesome download.
title: "Waffle"
output:
pdf_document:
latex_engine: xelatex
html_document: default
header-includes:
- \usepackage{fontspec}
- \defaultfontfeatures{Extension = .otf}
- \usepackage{fontawesome}
- \usepackage{tikz}
---
```{r setup, include=FALSE}
library(knitr)
knitr::opts_chunk$set(warning = FALSE, error = FALSE, message = FALSE, results='hide', echo = FALSE, dev = "tikz", external = TRUE)
```
## Font Awesome Gyphy
Font awesome glyphs are easy to integrate into the main text. For example: \faTwitter.
## Waffle Plot
You can also embed plots with glyphs and custom fonts, for example: \newline
```{r pressure, echo=FALSE, dev="quartz_pdf", dev.args=list(family = "Helvetica")}
## ---- waffle_figure ----
loadpackages <- function(package.list = c("ggplot2", "Rcpp")) {
new.packages <- package.list[!(package.list %in% installed.packages()[,"Package"])]
if (length(new.packages)){install.packages(new.packages, repos = 'http://cran.us.r-project.org')}
lapply(eval(package.list), require, character.only = TRUE)}
loadpackages(c("waffle", "extrafont", "grid", "gridExtra"))
# font_import() # Run this command, type "y", and press enter after installing new fonts.
parts <- c(40, 30, 20, 10)
waffle(parts,
rows=10,
use_glyph = "user",
glyph_size = 7)+ggtitle("Some Sample Text Here")+
theme(plot.title = element_text(family="LM Roman 10"))
```