如何获取单选按钮的值来绘制特定的ggvis图?

时间:2015-08-20 23:10:59

标签: r ggplot2 shiny shiny-server ggvis

我有这个闪亮的应用程序,我从用户那里获取输入,并根据用户想要的情节类型显示该情节。但是我无法获取应用程序上的单选按钮的值并使用它来绘制特定的ggvis图,因为"输入$" value只能在我不在这里使用的render *函数中使用,因为我使用ggvis绘图。

我的ui.R文件 -

library(ggvis)

shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("Xvar", "Choose X variable", choices = colnames(the.data), selected = colnames(the.data)[[2]] ),
      selectInput("Yvar", "Choose Y variable", choices = colnames(the.data), selected = colnames(the.data)[[3]] ),
      selectInput("IDvar", "Choose ID variable", choices = colnames(the.data), selected = colnames(the.data)[[4]] ),
      uiOutput("choose_COVvar"),
      uiOutput("choose_COVn"),
      br()
    ),
    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("Data Exploration", 
                           uiOutput("plot_type"), 
                           br(), 
                           ggvisOutput("ggvis_xy_plot")),
                           ggvisOutput("ggvis_profile_plot")  
      )
    )
  )
)) 

server.R文件 -

library(ggvis)
library(shiny)


shinyServer(function(input, output, session) {
  the.data <<- mtcars

  output$plot_type <- renderUI({
    fluidRow(
      column(4, offset = 1,
             radioButtons("PlotMethod", h5("Plot type"), c("XY Scatter plot",
                                                           "profile plot"))
      )
    )
  })

  flex.data <- reactive({
    x.name <- input$Xvar
    y.name <- input$Yvar
    id.name <- input$IDvar

    x.data <- the.data[, x.name]
    y.data <- the.data[, y.name]
    ID.t <- the.data[, id.name]
    new.data <- data.frame(x.data, y.data, ID.t)
  })

  lb <- linked_brush(keys = 1:nrow(flex.data()), "red")

  flex.data %>%
    ggvis(~x.data, ~y.data) %>%
    layer_points(fill := lb$fill, fill.brush := "red") %>%
    lb$input()  %>%
    layer_points(fill := "red", data = reactive(flex.data()[flex.data()$ID.t %in%
                                                              flex.data()[lb$selected(), ]$ID.t, ])) %>% 
    bind_shiny("ggvis_xy_plot")

  flex.data %>%
    ggvis(~x.data, ~y.data) %>%
    layer_points() %>%
    layer_lines() %>%
    bind_shiny("ggvis_profile_plot")
})

正如你所看到的,目前散点图和线图都在那里,但我希望它只是一个,取决于用户按下的上面的单选按钮。

任何帮助将不胜感激。感谢

1 个答案:

答案 0 :(得分:0)

我修改了您的ui.Rserver.R。看看评论:

<强> ui.R

library(ggvis)

shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("Xvar", "Choose X variable", choices = colnames(the.data), selected = colnames(the.data)[[2]] ),
      selectInput("Yvar", "Choose Y variable", choices = colnames(the.data), selected = colnames(the.data)[[3]] ),
      selectInput("IDvar", "Choose ID variable", choices = colnames(the.data), selected = colnames(the.data)[[4]] ),
      uiOutput("choose_COVvar"),
      uiOutput("choose_COVn"),
      br()
    ),
    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("Data Exploration", 
                           uiOutput("plot_type"), 
                           br(), 
                           ggvisOutput("plot"))
      )
    )
  )
)) 

<强> server.R

library(ggvis)
library(shiny)

shinyServer(function(input, output, session) {
  the.data <<- mtcars

  output$plot_type <- renderUI({
    fluidRow(
      column(4, offset = 1,
             radioButtons("PlotMethod", h5("Plot type"), c("XY Scatter plot",
                                                           "profile plot"))
      )
    )
  })

  flex.data <- reactive({
    x.name <- input$Xvar
    y.name <- input$Yvar
    id.name <- input$IDvar

    x.data <- the.data[, x.name]
    y.data <- the.data[, y.name]
    ID.t <- the.data[, id.name]
    new.data <- data.frame(x.data, y.data, ID.t)
  })

  lb <- linked_brush(keys = 1:nrow(flex.data()), "red")

  # Set binder as a reactive expression, returning an object dependent on the radio buttons
  # By default, take the first one, i.e. if "profile plot" is selected or the radio button has not been loaded yet
  binder <- reactive({
    if(!is.null(input) & !is.null(input$PlotMethod)) {
      if(input$PlotMethod == "profile plot") {
        plt <- flex.data %>%
          ggvis(~x.data, ~y.data) %>%
          layer_points() %>%
          layer_lines()
      }
    }
    if (!exists("plt")) {
      plt <- flex.data %>%
        ggvis(~x.data, ~y.data) %>%
        layer_points(fill := lb$fill, fill.brush := "red") %>%
        lb$input()  %>%
        layer_points(fill := "red", data = reactive(flex.data()[flex.data()$ID.t %in%
          flex.data()[lb$selected(), ]$ID.t, ]))      
    }
    plt
  })
  binder %>% bind_shiny("plot") # Bind whatever is behind binder
})