子集数据框和ggplot图?

时间:2018-06-14 11:53:34

标签: r ggplot2 shiny subset

我创建了一个闪亮的应用程序,需要一些帮助我的数据子集。我插入dateRangeInput,客户端可以在开始日期和结束日期之间进行过滤。此过滤器包含在我的ggplot代码中,因此当选择其他日期时,绘图始终会自动更改。我的问题是它不会根据所选日期,即partC的数据进行过滤。问题是这行代码:geom_line(aes(x = Date, y = OLS.Data[partC]), color="red")partC是一个连接到selectinputs以访问我的数据帧的变量。示例:客户选择input1 = Informedinput2 = FullpartC生成InformedFull(这是我的数据集的一列的名称),依此类推。所以partC只是两个输入的连接器,这是我的问题。如果我将此代码放入我的geom_line中,例如geom_line(aes(x = Date, y = InformedFull), color="red"),而上述所有内容都可以完美运行,但我需要使用partC。

这是我的ui.R代码(只是必要部分):

        box(
          title = "Controls-0", 
          status = "primary", 
          solidHeader = TRUE,
          width = 3,
          height = 142,
          dateRangeInput("daterange", "SELECT DATE:", start = min(OLS.Data$Date), end = max(OLS.Data$Date))
        ), 

            box(
              title = "Investor Control", 
              status = "primary", 
              solidHeader = TRUE,
              width = 3,
              selectInput("investor", label="Select Investor", choices = list("Informed" = "Informed", "Noise" = "Noise"), selected = "Informed")
            ),

            box(
              title = "Category Control", 
              status = "primary", 
              solidHeader = TRUE,
              width = 3,
              selectInput("category", label="Select Category", choices = list("Full" = "Full", "Fact" = "Fact", "Fact Positive" = "Fact.Pos", "Fact Negative" = "Fact.Neg", "Emotions" = "Emotions", "Emotions Fact" = "EmotionsFact"), selected = "Full")
            ),

使用ggplot更新server.R:

server <- function(input, output) {

  partC = NULL

  makeReactiveBinding("partC")


  observeEvent(input$investor, { 
    partA<<-input$investor
    partA<<-as.character(partA)
  })

  observeEvent(input$category, { 
    partB<<-input$category
    partB<<-as.character(partB)
  })

  OLS.Data$InformedEmotionsFact <- as.numeric(as.character(OLS.Data$InformedEmotionsFact))
  OLS.Data$NoiseEmotionsFact <- as.numeric(as.character(OLS.Data$NoiseEmotionsFact))

  output$myPlotVisu <- renderPlot({
    partC<-as.character(paste(partA,partB,sep=""))

    OLS.Data %>%
      select(partC, NYSE,Date,Sector) %>%
      filter(Date >= input$daterange[1], Date <= input$daterange[2]) %>%
      ggplot(aes(x = Date, y = NYSE)) +
      geom_line() +
      ggtitle(paste(input$investor,input$category,sep = "")) +
      theme(plot.title = element_text(hjust = 0.5,face="bold")) +
      labs(x="Time",y="Return S&P500") +
      geom_line(aes(x = Date, y = OLS.Data[partC]), color="red")
  })

1 个答案:

答案 0 :(得分:0)

我不知道为什么要将partA / partB分配给全局环境,甚至两次。你不需要这样做。我创建了一个reactiveValues对象,您可以在其中存储值(partA,partB和partC)。然后,您可以在应用中的任何位置使用它们。

以下示例可能会帮助您处理代码。我为它创建了一些虚拟数据。

library(shiny)
library(shinydashboard)
library(ggplot2)

## DATA #######################
DateSeq = seq(as.Date("1910/1/1"), as.Date("1911/1/1"), "days")

OLS.Data = data.frame(
  ID = 1:length(DateSeq),
  Date = DateSeq,
  NoiseEmotionsFact = sample(1:100,length(DateSeq), T),
  InformedEmotionsFact = sample(100:1000,length(DateSeq), T),
  InformedFull = sample(10:1000,length(DateSeq), T),
  NoiseFull = sample(50:5000,length(DateSeq), T),
  NoiseFact = sample(1:15,length(DateSeq), T),  
  NoiseFact.Pos = sample(100:110,length(DateSeq), T),
  NoiseFact.Pos = sample(10:200,length(DateSeq), T)
)


## UI #######################
ui <- {dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    plotOutput("myPlot"),
    box(
      title = "Controls-0", 
      status = "primary", 
      solidHeader = TRUE,
      width = 3,
      height = 142,
      dateRangeInput("daterange", "SELECT DATE:", start = min(OLS.Data$Date), end = max(OLS.Data$Date))
    ),
    box(
      title = "Alpha",
      sliderInput("alphaVisu", label = "Alpha :", min = 0, max = 1, value = 0.4, step = 0.1)
    ),

    box(
      title = "Investor Control", 
      status = "primary", 
      solidHeader = TRUE,
      width = 3,
      selectInput("investor", label="Select Investor", 
                  choices = list("Informed" = "Informed", "Noise" = "Noise"), selected = "Informed")
    ),

    box(
      title = "Category Control", 
      status = "primary", 
      solidHeader = TRUE,
      width = 3,
      selectInput("category", label="Select Category", 
                  choices = list("Full" = "Full", "Fact" = "Fact", "Fact Positive" = "Fact.Pos", 
                                 "Fact Negative" = "Fact.Neg", "Emotions" = "Emotions", 
                                 "Emotions Fact" = "EmotionsFact"), selected = "Full")
    )
  )
)}

## SERVER #######################
server <- function(input, output) {

  ## Reactive Values ############
  parts <- reactiveValues(partA=NULL, partB=NULL, partC=NULL)

  ## Observe Events ############
  observeEvent(input$investor, { 
    parts$partA <- as.character(input$investor)
  })
  observeEvent(input$category, { 
    parts$partB <- as.character(input$category)
  })

  ## Plot ############
  output$myPlot <- renderPlot({

    parts$partC <- as.character(paste(parts$partA, parts$partB,sep=""))

    OLS.Data.filtered <-  OLS.Data %>%
      filter(Date >= input$daterange[1], Date <= input$daterange[2])

    req(OLS.Data.filtered)

    OLS.Data.filtered %>% 
      ggplot(aes(x = Date, y = ID)) +
      geom_line() +
      ggtitle(paste("input$investor","input$category",sep = "")) +
      theme(plot.title = element_text(hjust = 0.5,face="bold")) +
      labs(x="Time",y="Return S&P500") +

      geom_line(aes(x = Date, y = OLS.Data.filtered[parts$partC]), color="red", 
                alpha = rep(as.numeric(input$alphaVisu), nrow(OLS.Data.filtered[parts$partC])))
  })
}

shinyApp(ui, server)