我有下面的shiny应用程序,当用户上传一个EXCEL文件时,会显示selectInput()及其列名,还会显示一个指向已部署的shiny应用程序的URL.

这个部署了shiny的应用程序现在部署了data<-irisy<-Petal.Length,但我想做的是将上传的文件作为data传递给它,并将选定的列名作为y.然后它将工作(没有问题与此)

我怎样才能做到这一点?我知道也许一个选项可以使用API,另一个选项可以使用pins包,但我不确定如何做到这一点.当然,我对其他解决方案持开放态度.

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)

推荐答案

为了详细说明我的 comments ,使用参数,你的初始应用程序应该如下所示:

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

部署的应用程序将如下所示:

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

但正如我所说的,如果数据集很大,这将生成一个长URL,这在某些浏览器中是不可接受的.减少的一种方法是只发送选定的列.

或者,不用为数据使用URL参数,而是将数据上传到带有gistr package的Gist,将Gist标识符放在URL参数中,然后在部署的应用程序中,使用gistr从该Gist获取数据.


Edit: using JSON blob

如果你没有Github账户,你可以使用JSON blob website来存储数据,并在部署的应用程序中检索数据.下面我将展示如何使用httr2包执行HTTP请求.

最初的应用程序:

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)

部署的应用程序:

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

R相关问答推荐

如何在弹性表中为类别值的背景上色

r中的stat_difference函数不起作用

将复杂的组合列表转换为数据框架

根据R中两个变量的两个条件删除带有dspirr的行

如何对数据集进行逆向工程?

修改用R编写的用户定义函数

单个轮廓重叠条的单独图例

如何自定义3D散点图的图例顺序?

在ggplot中为不同几何体使用不同的 colored颜色 比例

将. xlsx内容显示为HTML表

根据现有列的名称和字符串的存在进行变异以创建多个新列

如何将使用rhandsontable呈现的表值格式化为百分比,同时保留并显示完整的小数精度?

在R中,我如何使用滑动窗口计算位置,然后进行过滤?

自定义gggraph,使geom_abline图层仅在沿x轴的特定范围内显示

将多个变量组合成宽格式

在使用具有Bray-Curtis相似性的pvCluust时计算p值

如何计算每12行的平均数?

数值型数据与字符混合时如何进行绑定

R:如何在数据集中使用Apply

基于R中的引用将向量值替换为数据框列的值