I have the shiny app below in which when the user uploads an excel file then a selectInput() with its column names is displayed and also a url that leads to a deployed shiny app.
This deployed shiny app is now deployed with data<-iris and y<-Petal.Length but what I want to do is to pass to it the uploaded file as data and the selected column name as y. Then it will work (no problem with this)
How can I achieve it? I know that maybe one option would with an API and another with the pins package but Im not sure how to do it. Of course Im open to alternative solution.
initial app
# Install and load necessary packages
library(shiny)
library(pins)
# Define the UI
ui <- fluidPage(
titlePanel("Shiny App with Link"),
column(3, fileInput("file1", "Upload File", multiple = FALSE, accept = c(".csv", ".xlsx", ".xls"))),
uiOutput("select"),
uiOutput("tab"),
)
# Define the server
server <- function(input, output,session) {
url <- a("Shinyapp", href="https://deniz4shinyml.shinyapps.io/iris/")
output$tab <- renderUI({
req(input$file1)
tagList("URL link:", url)
})
file_info <- reactive({
req(input$file1)
"xlsx" = readxl::read_excel(input$file1$datapath)
})
#####pins######
board_rsc <- pins::board_connect()
board_rsc %>% pin_write(file_info())
######pins#####
output$select<-renderUI({
req(input$file1)
selectInput("sel","select one column",choices = unique(colnames(file_info())),
selected = unique(colnames(file_info()))[1],
multiple = F)
})
}
# Run the app
shinyApp(ui, server)
deployed app
# Load required libraries
library(shiny)
library(ggplot2)
library(pins)
# Load Iris dataset
data<-iris
y<-"Petal.Length"
######pin section
#data<-pin_read(board_rsc)
#y=?
########
# Define the UI for the Shiny app
ui <- fluidPage(
titlePanel("Iris Sepal Scatterplot"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotOutput("scatterplot")
)
)
)
# Define the server logic for the Shiny app
server <- function(input, output) {
output$scatterplot <- renderPlot({
ggplot(data, aes(x = Sepal.Length, y = data[[y]])) +
geom_point()
})
}
# Run the Shiny app
shinyApp(ui, server)
To elaborate my comment, using parameters, your initial app would look like:
ui <- fluidPage(
titlePanel("Shiny App with Link"),
fileInput("file1", "Upload File", multiple = FALSE, accept = c(".csv", ".xlsx", ".xls")),
uiOutput("select"),
uiOutput("tab")
)
server <- function(input, output,session) {
output$tab <- renderUI({
jsonData <- jsonlite::toJSON(Data())
parameters <-
paste0("data=", URLencode(jsonData), "&y=", URLencode(input$sel))
url <- paste0("https://deniz4shinyml.shinyapps.io/iris/?", parameters)
tags$a("Shinyapp", href = url)
}) |> bindEvent(input$sel)
Data <- eventReactive(input$file1, {
path <- input$file1$datapath
ext <- tools::file_ext(path)
switch(
ext,
xlsx = readxl::read_xlsx(path),
xls = readxl::read_xls(path),
csv = read.csv(path)
)
})
output$select <- renderUI({
selectInput(
"sel", "select one column", choices = colnames(Data()),
multiple = FALSE
)
}) |> bindEvent(Data())
}
And the deployed app would look like:
ui <- fluidPage(
titlePanel("Iris Sepal Scatterplot"),
sidebarLayout(
sidebarPanel(),
mainPanel(
plotOutput("scatterplot")
)
)
)
server <- function(input, output, session) {
Data <- reactiveVal()
y <- reactiveVal()
observe({
query <- parseQueryString(session$clientData$url_search)
Data(jsonlite::fromJSON(query$data))
y(query$y)
})
output$scatterplot <- renderPlot({
ggplot(Data(), aes(x = Sepal.Length, y = .data[[y()]])) +
geom_point()
}) |> bindEvent(Data(), y())
}
But as I said, if the dataset is large, this would generate a long url which is not acceptable in some browsers. One way to reduce is to send only the selected column.
Or, instead of using a URL parameter for the data, upload the data to a Gist with the gistr package, put the Gist identifiant in a URL parameter, and in the deployed app, use gistr to get the data from this Gist.
If you don't have a Github account, you can use the JSON blob website to store the data and retrieve it in the deployed app. Below I show how to do so by using the httr2 package to perform the HTTP requests.
Initial app:
library(shiny)
library(httr2)
ui <- fluidPage(
titlePanel("Shiny App with Link"),
fileInput("file1", "Upload File", multiple = FALSE, accept = c(".csv", ".xlsx", ".xls")),
uiOutput("select"),
uiOutput("tab")
)
server <- function(input, output,session) {
output$tab <- renderUI({
dataToSend <- list(data = Data(), y = input$sel)
# send the data to jsonBlob
req <- request("https://jsonblob.com/api/jsonBlob")
post <- req |>
req_body_json(dataToSend) |>
req_perform()
# get the url of the posted data
blobURL <- resp_header(post, "location")
#
parameters <- paste0("url=", URLencode(blobURL))
url <- paste0("https://deniz4shinyml.shinyapps.io/iris/?", parameters)
tags$a("Shinyapp", href = url)
}) |> bindEvent(input$sel)
Data <- eventReactive(input$file1, {
path <- input$file1$datapath
ext <- tools::file_ext(path)
switch(
ext,
xlsx = readxl::read_xlsx(path),
xls = readxl::read_xls(path),
csv = read.csv(path)
)
})
output$select <- renderUI({
selectInput(
"sel", "select one column", choices = colnames(Data()),
multiple = FALSE
)
}) |> bindEvent(Data())
}
shinyApp(ui, server)
Deployed app:
library(shiny)
library(httr2)
ui <- fluidPage(
titlePanel("Iris Sepal Scatterplot"),
sidebarLayout(
sidebarPanel(),
mainPanel(
plotOutput("scatterplot")
)
)
)
server <- function(input, output, session) {
Data <- reactiveVal()
y <- reactiveVal()
observe({
query <- parseQueryString(session$clientData$url_search)
url <- query$url
if(!is.null(url)) {
# get the contents of the blob at this url
List <- request(url) |> req_perform() |> resp_body_json()
Data(List$data)
y(List$y)
} else {
print("hmm.. strange!")
}
})
output$scatterplot <- renderPlot({
ggplot(Data(), aes(x = Sepal.Length, y = .data[[y()]])) +
geom_point()
}) |> bindEvent(Data(), y())
}