r - 从 Shiny 的上传文件创建动态ggvis图表

Question

我正在尝试使用 Shiny 和 ggvis 来:

1)上传数据集

2) 让用户选择 2 列 (x, y)

3) 从上传的数据集中返回一个显示 (x, y) 的 ggvis 图

我尝试编辑来自 Shiny Interactivity 的示例页面以及movie explorer例子。但是，不显示图表。

我认为我的问题是关于上传数据集，但我不知道从哪里开始......有什么建议吗？

注意 - 我也使用 rCharts 尝试过这个，但我遇到了类似的问题，没有显示图表。

server.R

library(shiny)
library(dplyr)
library(ggvis)

shinyServer(function(input, output, session) {

fileHeaderNames <- reactive({

  infile <- input$datfile

  if(is.null(infile))
    return(NULL)

  d <- read.csv(infile$datapath, header = T)
  return(names(d))

})

# dynamic variable names
observe({

  updateSelectInput(session, 'x', choices = fileHeaderNames())
  updateSelectInput(session, 'y', choices = fileHeaderNames())

}) # end observe

  # uploading data set
  theData <- reactive({ 

    validate(
       need(input$datfile != "", "Please upload a file")
    )

    infile <- input$datfile
    dat <- read.csv(infile$datapath, 
                    header = T,
                    stringsAsFactors = F)

    if(is.null(infile)) return(NULL)

    data.frame(x = dat[, input$x],
               y = dat[, input$y])

    })

  # A simple visualisation. In shiny apps, need to register observers
  # and tell shiny where to put the controls
  theData %>%
    ggvis(~x, ~y) %>%
    layer_points() %>%
    bind_shiny("plot", "plot_ui")

})

ui.R

library(ggvis)
library(shiny)
shinyUI(pageWithSidebar(
  div(),
  sidebarPanel(
    fileInput('datfile', ''),
    selectInput('x', 'x:' ,'x'),
    selectInput('y', 'y:', 'y'),
    uiOutput("plot_ui")
  ),
  mainPanel(
    ggvisOutput("plot")
  )
))

Answer 1

这是一个尝试，我添加了几个 react 块来获取应该添加在绘图轴上的名称。

您可以使用的一个技巧是创建一个包含两列的过滤数据框 x和 y当用户更改 selectInput 中的值时，情况会发生变化.然后你可以告诉 ggvis绘制 x和 y从过滤后的数据框中，绘图将是交互式的。

library(shiny)
library(dplyr)
library(ggvis)

shinyServer(function(input, output, session) {
  #load the data when the user inputs a file
  theData <- reactive({
    infile <- input$datfile        
    if(is.null(infile))
      return(NULL)        
    d <- read.csv(infile$datapath, header = T)
    d        
  })



  # dynamic variable names
  observe({
    data<-theData()
    updateSelectInput(session, 'x', choices = names(data))
    updateSelectInput(session, 'y', choices = names(data))

  }) # end observe

  #gets the y variable name, will be used to change the plot legends
  yVarName<-reactive({
    input$y
  })

 #gets the x variable name, will be used to change the plot legends
  xVarName<-reactive({
    input$x
  })

  #make the filteredData frame

  filteredData<-reactive({
    data<-isolate(theData())
    #if there is no input, make a dummy dataframe
    if(input$x=="x" && input$y=="y"){
      if(is.null(data)){
        data<-data.frame(x=0,y=0)
      }
    }else{
      data<-data[,c(input$x,input$y)]
      names(data)<-c("x","y")
    }
    data
  })

  #plot the ggvis plot in a reactive block so that it changes with filteredData
  vis<-reactive({
    plotData<-filteredData()
    plotData %>%
    ggvis(~x, ~y) %>%
    layer_points() %>%
    add_axis("y", title = yVarName()) %>%
    add_axis("x", title = xVarName()) %>%
    add_tooltip(function(df) format(sqrt(df$x),digits=2))
  })
    vis%>%bind_shiny("plot", "plot_ui")

})

编辑:添加了工具提示。