How can I plot a processmap (bupar) in shiny (R)? - r

in my application I want to upload a local csv-file (eventlog), display the datatable and after that create a processmap with the data from the csv-file (bupar). In a normal R-script, the creation of a processmap is working fine. But how can I plot a processmap (below the DataTables) in a shiny application with a button press on the button 'createDiagram'? Thanks in advance!
Below the code:
library(shiny)
ui <- fluidPage(
titlePanel("Visualization"),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose a File:",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
tags$hr(),
actionButton("createDiagram","Create a Process Diagram"),
tags$hr()
),
mainPanel(
tableOutput("contents"),
plotOutput("plot")
)
)
)
server <- function(input, output) {
output$contents <- renderTable({
req(input$file1)
tryCatch(
{
inputData <- read.csv2(input$file1$datapath)
},
error = function(e) {
stop(safeError(e))
}
)
})
}
# Create Shiny app ----
shinyApp(ui, server)

processmap() outputs a dgr_graph object. These can be rendered in a shiny app with
library(DiagrammeR)
grVizOutput(outputId = "process")
and
output$process <- renderGrViz({
plot <- process_map(eventlog, render = F)
render_graph(plot)
})

Related

R Shiny allow user to select one or multiple datasets to download

I am new to R shiny and I hope someone can please guide me in the right direction.
I want the user to be able to select one or multiple datasets to download.
Code works when I put the multiple=F in selectInput but when I change it to TRUE, I get the error below:
"Warning: Error in switch: EXPR must be a length 1 vector"
Any help will be greatly appreciated as I am stuck on this for days.
Thank you
library(shiny)
library(openxlsx)
# Define UI for data download app ----
ui <- fluidPage(
# App title ----
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars"), multiple=T),
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
tableOutput("table")
)
)
)
# Define server logic to display and download selected file ----
server <- function(input, output) {
# Reactive value for selected dataset ----
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# Table of selected dataset ----
output$table <- renderTable({
datasetInput()
})
# Downloadable xlsx of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
"selected.xlsx"
},
content = function(filename) {
write.xlsx(datasetInput(), file = filename, rowNames = FALSE)
}
)
}
# Create Shiny app ----
shinyApp(ui, server)
In order to display several datasets, you can create a module (it is like creating a smaller shiny app inside your shiny app that you can call with parameters, just like a function). Here I created a module to display a table, with a dataframe as parameter.
For the download, I followed the link I gave you previously.
library(shiny)
#Using module
mod_export_table_ui <- function(id){
ns <- NS(id)
tagList(
tableOutput(ns("table_export"))
)
}
mod_export_table_server <- function(input, output, session, df_export){
ns <- session$ns
output$table_export <- renderTable({
df_export
})
}
# Define UI for data download app ----
ui <- fluidPage(
# App title ----
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars"), multiple=T),
# Button
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
uiOutput("tables")
)
)
)
# Define server logic to display and download selected file ----
server <- function(input, output, session) {
rv <- reactiveValues()
#List of datasets
observeEvent(input$dataset, {
req(input$dataset)
rv$lst_datasets <- lapply(
1:length(input$dataset),
function(i) {
head(eval(parse(text =input$dataset[i])))
}
)
})
# Module UIs
output$tables <- renderUI({
req(rv$lst_datasets)
lapply(
1:length(rv$lst_datasets),
function(i) {
mod_export_table_ui(id = paste0("table", i))
}
)
})
# Module Servers
observeEvent(rv$lst_datasets, {
req(rv$lst_datasets)
lapply(
1:length(rv$lst_datasets),
function(i) {
callModule(
module = mod_export_table_server,
session = session,
id = paste0("table", i),
df_export = rv$lst_datasets[[i]]
)
}
)
})
output$downloadData <-downloadHandler(
filename = "Downloads.zip",
content = function(file){
withProgress(message = "Writing Files to Disk. Please wait...", {
temp <- setwd(tempdir())
on.exit(setwd(temp))
files <- c()
for(i in 1:length(rv$lst_datasets)){
writexl::write_xlsx(rv$lst_datasets[[i]],
path = paste0("dataset",i, ".xlsx")
)
files <- c(files, paste0("dataset",i, ".xlsx"))
}
zip(zipfile = file, files = files)
})
}
)
}
# Create Shiny app ----
shinyApp(ui, server)

How to read csv file and render UI?

I have a simple shiny app and when I press a button a .csv file is saved in the directory where the file app.R is.
I want to be able to read this csv file and render the information in a table on my shiny app.
This is a similiar example about what I would like to do
df <- data.frame(no =c(1:3),money=c(9999:10001),penalty=c(999:1001))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
tags$hr(),
checkboxInput("header", "Header", TRUE),actionButton("sort","Do Sorting")
),
mainPanel(
tableOutput("contents"),tableOutput("sortedcontents")
)
)
)
server <- function(input, output) {
rawInputData = reactive({
rawData = input$file1
if(!is.null(rawData)) {
data = read.csv(rawData$datapath);
} else {
return(NULL);
}
});
output$contents <- renderTable({
newData = rawInputData()
if(is.null(newData))
return();
newData;
})
sorting = reactive({
if(input$sort){
newData = rawInputData()
newData$moneysort <- ifelse(newData$money >=10000, 1, 0)
newData$penaltysort <- ifelse(newData$penalty >=1000, 1, 0)
}
newData
})
output$sortedcontents <- renderTable({
newData = sorting()
if(is.null(newData))
return();
newData;
})
}
}
shinyApp(ui, server)
Instead to have the opportunity to choose the file with a fileInpunt() I would like to avoid this step and automatically check a specific directory to look for the csv called "myData.csv" and render this csv in a table.
Here is an example of just reading data from local directory and rendering in shiny.
library(shiny)
write.csv(iris, 'iris.csv')
df = read.csv('iris.csv')
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
tableOutput('iris_table')
)
)
),
server = function(input, output) {
output$iris_table <- renderTable(df)
}
)
This example uses a slight modification from this shiny TableOutput reference.

How to show example data and then update user's data in shiny?

Here is an example. What I wanted is to display the example data if user click Show example or will display the data uploaded by user.
df<-data.frame(x=rnorm(9),
y=rnorm(9),
z=rnorm(9))
write.table(df, "test.txt", quote=F)
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test"),
sidebarPanel(
actionButton("evReactiveButton", "Show example"),
fileInput("file1", "Upload File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv"))
),
mainPanel(
tableOutput("matrix")
)
))
server <- function(input, output, session) {
#if action button show example
datobj<-reactive({
dat<-matrix(1:100, nrow=10)
return(dat)
})
#if user upload
datobj <- reactive({
req(input$file1)
dat <- read.table(input$file1$datapath)
return(dat)
})
### matrix file
output$matrix <- renderTable({
return(datobj())
})
}
shinyApp(ui=ui,server=server)
Here's one way to do it using observeEvent. I added an actionButton to switch more easily between the example data (not reactive here) and the data the user imports. If you want to remove this button, don't forget to replace also the second observeEvent environment by observe.
df<-data.frame(x=rnorm(9),
y=rnorm(9),
z=rnorm(9))
write.table(df, "test.txt", quote=F)
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test"),
sidebarPanel(
actionButton("example", "Show example"),
fileInput("file1", "Upload File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
actionButton("import", "Show data imported")
),
mainPanel(
tableOutput("matrix")
)
))
server <- function(input, output, session) {
#if action button show example
datobj<- mtcars
#if user upload
datobj2 <- reactive({
req(input$file1)
dat <- read.table(input$file1$datapath, sep = " ")
return(dat)
})
### matrix file
observeEvent(input$example, {
output$matrix <- renderTable({
datobj
})
})
observeEvent(input$import, {
if (!is.null(datobj2())){
output$matrix <- renderTable({
datobj2()
})
}
else {}
})
}
shinyApp(ui=ui,server=server)

Display a selected image from upload in Shiny UI

I want to be able to upload multiple images with file input and display the single image selected in the UI
ui.R
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file","Upload the file", multiple = TRUE), # fileinput() function is used to get the file upload contorl option
uiOutput("selectfile")
),
mainPanel(
uiOutput('images')
)
)
)
server.R
server <- function(input,output) {
## Side bar select input widget coming through renderUI()
# Following code displays the select input widget with the list of file loaded by the user
output$selectfile <- renderUI({
if(is.null(input$file)) {return()}
list(hr(),
helpText("Select the files for which you need to see data and summary stats"),
selectInput("Select", "Select", choices=input$file$name)
)
})
output$images <- renderImage({
if(is.null(input$file)) {return(NULL)}
for (i in 1:nrow(input$file))
{
if(input$file$name[i] == input$Select){
list(src=input$file$datapath[i],
alt= "error")
print(input$file$name[i])
print(input$file$datapath[i])
}
}
})
}
With this solution, the prints of the datapath and the name shows me the right answer but i keep getting the same error after trying to render the image: "Warning: Error in basename: a character vector argument expected".
Here is a solution using base64 encoding.
library(shiny)
library(base64enc)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file", "Upload the file", multiple = TRUE),
uiOutput("selectfile")
),
mainPanel(
uiOutput('image')
)
)
)
server <- function(input,output) {
output$selectfile <- renderUI({
req(input$file)
list(hr(),
helpText("Select the files for which you need to see data and summary stats"),
selectInput("Select", "Select", choices=input$file$name)
)
})
output$image <- renderUI({
req(input$Select)
i <- which(input$file$name == input$Select)
if(length(i)){
base64 <- dataURI(file = input$file$datapath[i], mime = input$file$type[i])
tags$img(src = base64, alt= "error")
}
})
}
shinyApp(ui, server)

Update checkboxGroupInput() choices after file upload

I have a simple shiny app below. In this app I want the user to be able to upload his own csv and then automatically this will be added as a choice in the checkbox group below the other dataset "D.B" (which I create in my original app).
#ui.r
ui <- fluidPage(
# App title ----
titlePanel("Uploading Files"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
uiOutput("checkbox"),
textInput("filename","Set Filename")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents")
)
)
)
#server.r
server <- function(input, output) {
output$contents <- renderTable({
req(input$file1)
df <- read.csv(input$file1$datapath)
})
D.B <- reactive({
#some code that creates the dataset D.B.
})
output$checkbox<-renderUI({
checkboxGroupInput("datasetSelector","Specify the datasets to compare:", choices = c("D.B")
)
})
}
You could use a reactive value to store choices then add a choice everytime a file is uploaded. Use an observer to watch for file uploads (I also used the library rlist which gives me the append method).
library(rlist)
#ui.r
ui <- fluidPage(
# App title ----
titlePanel("Uploading Files"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
uiOutput("checkbox"),
textInput("filename","Set Filename")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents")
)
)
)
#server.r
#fileOptions = list("D.B.")
server <- function(input, output, session) {
output$contents <- renderTable({
req(input$file1)
df <- read.csv(input$file1$datapath)
head(df)
})
fileOptions <- reactiveValues(currentOptions=c("D.B."))
observeEvent(input$file1, {
fileOptions$currentOptions = list.append(fileOptions$currentOptions, input$file1$datapath)
})
D.B <- reactive({
#some code that creates the dataset D.B.
})
output$checkbox<-renderUI({
checkboxGroupInput("datasetSelector","Specify the datasets to compare:", choices = fileOptions$currentOptions
)
})
}

Resources