问题描述
我一直在努力为我的 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)
解决方法
操作。没有您的数据，很难为您的特定问题提供明确的答案，但我可以向您展示如何使用 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)
