Subset Dataframe and plot with ggplot? [duplicate]

2019-08-19 10:26发布

This question already has an answer here:

I created a shiny app and need some help with the subset of my data. I insert a dateRangeInput where the client can filter between a start and end date. This filter is included into my ggplot code, so that the plot always automatically changes when a different date is selected. My problem is it does not filter based on the selected date, the data of partC. The problem is this line of code: geom_line(aes(x = Date, y = OLS.Data[partC]), color="red"). partC is a variable that connects to selectinputs to have access to my dataframe. Example: Client selects input1 = Informed and input2 = Full, partC makes InformedFull (which is the name of one column of my dataset) and so on. So partC is just a a connector of the two inputs, and this is my problem. If I put into my geom_line this code e.g geom_line(aes(x = Date, y = InformedFull), color="red"), instead the above everything works perfect, but I need it with partC.

Here is my ui.R code (only necessary part):

        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")
            ),

Update server.R with ggplot:

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条回答
▲ chillily
2楼-- · 2019-08-19 10:53

I dont know why you assign partA/partB to the global environment, and even twice. You dont need to do that. I created an reactiveValues object instead, where you store the values (partA, partB and partC). Then you can use them wherever you want in your app.

Maybe the following example will help you with your code. I created some dummy data for it.

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)
查看更多
登录 后发表回答