将滑块输入添加到 ShinyDashboard 中的 ggplot 折线图

如何解决将滑块输入添加到 ShinyDashboard 中的 ggplot 折线图

我一直在努力为我的 ggplot 折线图添加一个用于“观察次数”的功能滑块输入，但我不断收到错误.. 下面的代码有效但情节没有改变（我尝试了很多类似的东西）在 ggplot 中添加 reactive 函数或添加 input$obs 但它仍然不起作用）.. 我非常感谢您的帮助！谢谢

library(shiny)
library(shinydashboard)
library(readxl)
library(ggplot2)
library(dashboardthemes)
library(shinyWidgets)
library(dplyr)

df=read_excel("MASI.xlsx")

# Define UI for application that draws a histogram


ui <- dashboardPage(
    
    dashboardHeader(title = "Finance Dashboard"),dashboardSidebar(),dashboardBody(

        
        # Boxes need to be put in a row (or column)
        fluidRow(
 
        
        Box(
            title = "Line chart",status = "primary",solidHeader = TRUE,collapsible = TRUE,plotOutput("plot1",height = 250)
        ),Box(
            title = "MASI","The MASI index (Moroccan All Shares Index) is a stock index that tracks the performance of all 
                companies listed in the Casablanca Stock Exchange located at Casablanca."
        ),Box(
            title = "Inputs",sliderInput("obs","Number of observations:",min = 1,max = length(df$MASI),value = 50)
            
            
            
        ),),setBackgroundColor(
        color = "white",gradient = c("linear","radial"),direction = c("bottom","top","right","left"),shinydashboard = TRUE
    )
)



server <- function(input,output) {
    

    output$plot1 <- renderPlot({
       ggplot(df,aes(x=Session,y=MASI)) + geom_line( color="darkblue",size=0.7) + theme_bw()
    },bg="transparent")
    

}

shinyApp(ui,server)

编辑

感谢您的热情回答@chemdork123。

除了滑块输入之外，我还想添加一个日期范围。这是我所做的：

library(shiny)
library(shinydashboard)
library(readxl)
library(ggplot2)
library(dashboardthemes)
library(shinyWidgets)
library(dplyr)

df=read_excel("MASI.xlsx")

# Define UI for application that draws a histogram

Box_height = "20em"
plot_height = "16em"

ui <- dashboardPage(
    
    dashboardHeader(title = "Finance Dashboard"),value = 50),daterangeInput("date",strong("Date range"),start = "2015-01-02",end = "2020-07-17",min = "2015-01-02",max = "2020-07-17")
        ),Box(
            title = "Line chart",status = "success",plotOutput("plot2",Box(
            title = "Return","The relative difference of the MASI index"
        ),value = 50)
        ),output) {
    
    reactive_data <- reactive({
        set.seed(8675309)  # for some consistent sampling
        
        df <- df[sample(x=1:nrow(df),size = input$obs),]
        return(df)
        
        req(input$date)
        validate(need(!is.na(input$date[1]) & !is.na(input$date[2]),"Error: Please provide both a start and an end date."))
        validate(need(input$date[1] < input$date[2],"Error: Start date should be earlier than end date."))
        df %>%
            filter(
                date > as.POSIXct(input$date[1]) & date < as.POSIXct(input$date[2]
                ))
        
    })

    output$plot1 <- renderPlot({
       ggplot(reactive_data(),y=MASI)) + geom_line(color="darkblue",bg="transparent")

    
    
    output$plot2 <- renderPlot({
        ggplot(df,y=Return)) + geom_line( color="darkblue",bg="transparent")

}

shinyApp(ui,server)

这是 Dataset 的链接

Capture

解决方法

操作。没有您的数据，很难为您的特定问题提供明确的答案，但我可以向您展示如何使用 input$obs 滑块输入控件（或任何其他与此相关的）过滤和提供数据要显示的 ggplot() 函数。

这是一个可以运行的应用，它为您提供了两个控件来调整 mtcars 内置数据集中显示的数据。 sliderInput() 控件确定从总 mtcars 数据集中采样的行数。 selectInput() 控件允许您选择 mtcars$carb 的一个或所有值以根据采样数据集显示在图表中。

您将看到有关如何被动使用两个输入的一般方法是创建一个在 sample_cars() 函数内部调用的反应函数（称为 renderPlot()）。反应式函数 sample_cars() 返回在 ggplot() 调用中使用的数据帧。

library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(tidyr)

ui <- dashboardPage(
  
  dashboardHeader(title = "Example App"),dashboardSidebar(),dashboardBody(
  
    # Boxes need to be put in a row (or column)
    fluidRow(
      box(
        title = "Line chart",status = "primary",solidHeader = TRUE,collapsible = TRUE,plotOutput("plot1",height = 250)),box(
        title = "Inputs",sliderInput("obs","Number of observations:",min = 1,step = 1,max = nrow(mtcars),value = nrow(mtcars)),selectInput("carbs","Select carb to show",choices = c('All',unique(mtcars$carb))
        )
      ),)
  )
)

server <- function(input,output) {
  
  sample_cars <- reactive({
    set.seed(8675309)  # for some consistent sampling
    df <- mtcars[sample(x=1:nrow(mtcars),size = input$obs),]
    if(input$carbs != "All")
      df <- df %>% dplyr::filter(carb == input$carbs)
    return(df)
  })
  
  output$plot1 <- renderPlot({
    ggplot(sample_cars(),aes(mpg,disp)) + geom_point() +
      labs(title=paste('You selected',input$obs,'cars\n and to show',input$carbs,'values of carb!'))
  },bg="transparent")
}

shinyApp(ui,server)