天道酬勤,学无止境

R Shiny - How to create a barplot that reacts according to the time unit (Week, Month, Year) and aggregates data by time unit

问题

我使用以下变量生成有关疾病的数据框:

  • 日期(疾病日期)
  • 案例(案例数量,默认情况下,案例数量为1)
  • 周(病例周)
  • 月份(发病月份)
  • 年份(发病年份)。

我的用户界面在这里:

library(shiny) 
library(dplyr)
library(lubridate)
library(ggplot2)
library(scales)

Disease<-data.frame(Date=seq(as.Date("2015/1/1"), as.Date("2017/1/1"), "days"),Cases=rep(1))
Disease$Week<-as.Date(cut(Disease$Date,breaks="week",start.on.monday = TRUE))
Disease$Month<-as.Date(cut(Disease$Date,breaks="month"))
Disease$Year<-as.Date(cut(Disease$Date,breaks="year"))

ui <- fluidPage(
      dateRangeInput("daterange", "Choice the date",
      start = min(Disease$Date),
      end = max(Disease$Date),
      min = min(Disease$Date),
      max = max(Disease$Date),
      separator = " - ", format = "dd/mm/yy",
      startview = 'Month', language = 'fr', weekstart = 1),
      selectInput(inputId = 'Time_unit',
      label='Time_unit',
      choices=c('Week','Month','Year'),
      selected='Month'),
plotOutput("Disease"))

我希望创建一个根据时间单位(即周、月、年)做出反应并按时间单位聚合数据的条形图

您将在下面找到服务器的代码(但它不起作用):

server <- function(input, output) {
       dateRangeInput<-reactive({
       dataset= subset(Disease, Date >= input$daterange[1] & Date <= 
       input$daterange[2])
       return(dataset)
       })
selectInput= reactive({
summarize(group_by(dateRangeInput(),
period = switch(input$Time_unit,
"Week"=Disease$Week,
"Month" = Disease$Month,
"Year" = Disease$Year)))
})

output$Disease <-renderPlot({
ggplot(data=selectInput(), aes_string(x="period",x="Cases"))  
+ stat_summary(fun.y = sum, geom = "bar") 
+ labs(title="Disease", y ="Number of cases")
+theme_classic() 
+theme(plot.title = element_text(hjust = 0.5))
})

}
shinyApp (ui = ui, server = server)

如果我选择周、月或年,您将在下面找到我想获得的条形图:

  • 按月:https://i.stack.imgur.com/wyWoL.png

  • 按周:https://i.stack.imgur.com/jAWJq.png

对不起“按年”,我不能发布超过 2 个链接

回答1

您可以查看此代码,它正在按照您的意愿工作:

library(shiny) 
library(dplyr)
library(lubridate)
library(ggplot2)
library(scales)

Disease<-data.frame(Date=seq(as.Date("2015/1/1"), as.Date("2017/1/1"), "days"),Cases=rep(1))
Disease <- Disease %>% mutate(Week = format(Date, "%Y-%m-%U"),Month = format(Date, "%Y-%m"), Year = format(Date, "%Y"))

ui <- fluidPage(
  dateRangeInput("daterange", "Choice the date",
                 start = min(Disease$Date),
                 end = max(Disease$Date),
                 min = min(Disease$Date),
                 max = max(Disease$Date),
                 separator = " - ", format = "dd/mm/yy",
                 startview = 'Month', language = 'fr', weekstart = 1),
  selectInput(inputId = 'Time_unit',
              label='Time_unit',
              choices=c('Week','Month','Year'),
              selected='Month'),
  plotOutput("Disease"))


server <- function(input, output) {
  dateRangeInput<-reactive({
    dataset <- subset(Disease, Date >= input$daterange[1] & Date <= input$daterange[2])
    dataset
  })
  selectInput= reactive({
    dataset <- dateRangeInput() %>% group_by_(input$Time_unit) %>% summarise(Sum = sum(Cases))
    print(head(dataset))
    dataset
    })

  output$Disease <-renderPlot({
    ggplot(data=selectInput(), aes_string(x=input$Time_unit,y="Sum"))  + geom_bar(stat="identity") + 
    labs(title="Disease", y ="Number of cases") +
    theme_classic() + 
    theme(plot.title = element_text(hjust = 0.5))
  })

}
shinyApp (ui = ui, server = server)

绘图对Time_unit输入是反应性的,您只需要对轴文本进行小幅调整即可。

PS你的图片的第二个链接

按周

不工作 - >得到一个空白空间。

受限制的 HTML

  • 允许的HTML标签:<a href hreflang> <em> <strong> <cite> <blockquote cite> <code> <ul type> <ol start type> <li> <dl> <dt> <dd> <h2 id> <h3 id> <h4 id> <h5 id> <h6 id>
  • 自动断行和分段。
  • 网页和电子邮件地址自动转换为链接。

相关推荐
  • R Shiny - How to create a barplot that reacts according to the time unit (Week, Month, Year) and aggregates data by time unit
    I generate a dataframe about a disease with the following variables: Date (date of disease) Cases (number of cases, by default, the number of cases is 1) Week (week of disease case) Month (month of disease case) Year (year of disease case). My ui is here: library(shiny) library(dplyr) library(lubridate) library(ggplot2) library(scales) Disease<-data.frame(Date=seq(as.Date("2015/1/1"), as.Date("2017/1/1"), "days"),Cases=rep(1)) Disease$Week<-as.Date(cut(Disease$Date,breaks="week",start.on.monday = TRUE)) Disease$Month<-as.Date(cut(Disease$Date,breaks="month")) Disease$Year<-as.Date(cut(Disease
  • R Shiny Aesthetics 必须是长度为 1 或与数据 (8) 相同: y(R shiny Aesthetics must be either length 1 or the same as the data (8): y)
    问题 我试图在 R Shiny 中绘制多个折线图并包含复选框,但是当我尝试选择多个折线图时收到一条错误消息: 错误:Aesthetics 必须为长度 1 或与数据 (8) 相同:y 使用单选按钮时,我能够毫无错误地绘制它们,但复选框不起作用。 这是我的代码: library(readxl) scores <- read.csv("newscores.csv") weeks <- read.csv("weeks.csv") library(ggplot2) # ui.R fluidPage( # Give the page a title titlePanel("Fantasy Scores"), # Generate a row with a sidebar sidebarLayout( # Define the sidebar with one input sidebarPanel( checkboxGroupInput("Team", label = h3("Select Team"), choices = c("Jeff","Jordan","Emmerts", "CJ","Jimmy","Phil", "Mat","Clegg","Rob","Shawn", "Seth","Truscott")) ), # Create a spot for the barplot
  • R shiny Aesthetics must be either length 1 or the same as the data (8): y
    I am trying to plot multiple line charts in R Shiny and include checkboxes but I get an error message when I try to select more than one: Error: Aesthetics must be either length 1 or the same as the data (8): y I was able to plot them without error when using radio buttons, but checkboxes don't work. Here's my code: library(readxl) scores <- read.csv("newscores.csv") weeks <- read.csv("weeks.csv") library(ggplot2) # ui.R fluidPage( # Give the page a title titlePanel("Fantasy Scores"), # Generate a row with a sidebar sidebarLayout( # Define the sidebar with one input sidebarPanel(
  • R flexdashboard 和闪亮的交互式绘图(R flexdashboard and shiny interactive plot)
    问题 我正在学习 flexdashboard,但我没有明确的结构。 我创建了一个示例数据集,根据选定的变量在仪表板中绘制条形图。 代码如下: --- title: "flexdashboard: Shiny Embedding" output: flexdashboard::flex_dashboard: social: menu source_code: embed runtime: shiny --- ```{r global, include=FALSE} library(tidyverse) ## generate a sample dataset sample<-tbl_df(data.frame(c("City1","City2","City3","City1","City2","City3", "City2","City3"), c("A","B","C","D","D","A","A","B"), c(12,14,15,12,12,14,8,10))) colnames(sample)<-c("City","Country","Amount") df<- reactive(sample%>%group_by(input$variable)%>%summarise(total=sum(Amount))) ``` Column {.sidebar} ----------
  • Retrieving source data information from a barplot in R shiny interactively
    I have a barplot in R shiny. I want following: When user clicks one "bar" in that barplot another box will pop up and show the data information from the used datadframe showing which data points contributed to create that "bar". Code: ui <- fluidPage( sidebarLayout(sidebarPanel(), mainPanel(plotOutput("p",click = "plot_click"), textOutput("info")))) server <- function(input,output) { output$p <- renderPlot(ggplot(mtcars,aes(x=factor(carb),y=mpg))+ geom_bar(stat="summary",fun.y="mean")) output$info <- renderText( paste0("x=", input$plot_click$x, "\n", "y=", input$plot_click$y)) } shinyApp(ui
  • 以交互方式从 R Shiny 中的条形图中检索源数据信息(Retrieving source data information from a barplot in R shiny interactively)
    问题 我在 R 中有一个条形图。 我想要以下内容: 当用户单击该条形图中的一个“条”时,将弹出另一个框并显示来自使用过的 datadframe 的数据信息,显示哪些数据点有助于创建该“条”。 代码: ui <- fluidPage( sidebarLayout(sidebarPanel(), mainPanel(plotOutput("p",click = "plot_click"), textOutput("info")))) server <- function(input,output) { output$p <- renderPlot(ggplot(mtcars,aes(x=factor(carb),y=mpg))+ geom_bar(stat="summary",fun.y="mean")) output$info <- renderText( paste0("x=", input$plot_click$x, "\n", "y=", input$plot_click$y)) } shinyApp(ui, server) 当我单击一个条形时,它会显示 (x,y) 坐标值。 但我想检索相应的因子(碳水化合物)。 如果我单击一个栏,如何取回源信息。 理想的情况是:当用户点击 carb=4 的栏时,它应该显示 carb=4 的 mtcars 数据集的源信息。
  • R flexdashboard and shiny interactive plot
    I am learning flexdashboard, but I dont have clear the structure. I have created a sample dataset to plot in a dashboard a barplot according to the selected variable. The code is the next: --- title: "flexdashboard: Shiny Embedding" output: flexdashboard::flex_dashboard: social: menu source_code: embed runtime: shiny --- ```{r global, include=FALSE} library(tidyverse) ## generate a sample dataset sample<-tbl_df(data.frame(c("City1","City2","City3","City1","City2","City3", "City2","City3"), c("A","B","C","D","D","A","A","B"), c(12,14,15,12,12,14,8,10))) colnames(sample)<-c("City","Country"
  • 在闪亮的R中使用selectInput选择记录日期(Selecting record date with selectInput in shiny R)
    问题 我对 R 编程非常陌生,我正在尝试构建一个闪亮的 r 应用程序,它接收鲨鱼攻击数据的数据并构建一个条形图,指定一种攻击的频率,例如挑衅、无端攻击、划船等。我想然而,能够按区域过滤。 这是数据集的示例。 CaseNumber Year Type Country Area OriginalOrder Region 1642.00.00 1642 Unprovoked USA New York 136 Northeast 1779.00.00 1779 Unprovoked USA Hawaii 152 West 1805.09.00 1805 Invalid USA New York 160 Northeast 1816.09.03 1816 Unprovoked USA Rhode Island 164 Northeast 1817.06.24 1817 Unprovoked USA South Carolina 168 South 1828.00.00 1828 Unprovoked USA Hawaii 181 West 1830.07.26 1830 Unprovoked USA Massachusetts 187 Northeast 1837.00.00 1837 Invalid USA South Carolina 196 South 1837.00.00 1837
  • 优衣库-销售服装-分析案例实战(BI-SQL-Python-Excel)
    本篇文章和网上最主要的区别是分别(使用BI)(使用MYSQL)(使用Python)(使用Excel)分别进行数据分析。 文章目录 一、BI(可视化展现(可PC端和移动端))二、(MYSQL版本)数据字段说明、创建、导入数据库、多维度字段查询分析。1.描述性统计2查看线上,各城市的产品类别,总客户数量,总销售金额,总订单数量,总购买的产品数量,总产品的成本,按销售金额,降序排序。3.重新计算公式(再次生成新表,增加四个字段)4.SQL查询-多维度-数据分析1.不同城市的顾客通过线上或线下购买的人数,并按照顾客数降序2.不同性别的顾客通过线上或线下购买的人数,并按照顾客数降序3.不同年龄段的顾客通过线上或线下购买的人数,,并按照顾客数降序4.不同城市销售渠道的顾客的平均购买金额对比,并降序5.不同城市性别的顾客的平均购买金额对比,并降序6.不同年龄段的顾客的客户数和平均购买力度对比,购买力度降序排序7.不同城市的年龄段的顾客的总客户数,平均购买金额,总利润,并按城市、总利润,依次降序。8.探究销售情况与购买时间的关系(周末与工作日的下单人数对比)9.不同产品的销售情况及利润高低 三、Python数据分析1.看了描述统计,发现销售金额revenue有负数2.由于销售收入和零收入存在较少,可以直接删除3.查看数据是都有重复4.查看是否有缺失值5对城市和销售渠道进行分组
  • Shiny - Error in : Problem with `filter()` input `..1`
    I'm trying to make an app with shiny, when I run the app with the code below appears an error. Error: Warning: Error in : Problem with `filter()` input `..2`. ℹ Input `..2` is `site == input$cueva`. x Input `..2` must be of size 672 or 1, not size 0. 202: <Anonymous> library(shiny) library(shinyWidgets) sampleTypeVector <- c("Tapete microbiano", "Estromatolito", "Sedimento", "Suelo") caves <- c("Chimalacatepec", "Iglesia") ui <- fluidPage( titlePanel("Taxonomic composition"), fluidRow( column(4, " ", pickerInput("sample.type", label = "Sample", choices = sampleTypeVector, multiple = TRUE
  • R Shiny:刷新/覆盖 actionButton() 输出(R Shiny: refreshing/overriding actionButton() output)
    问题 我正在尝试将 R Shiny: 自动刷新主面板而不使用刷新按钮调整为新的最小工作示例: ui <- fluidPage( pageWithSidebar( headerPanel("actionButton test"), sidebarPanel( numericInput("n", "N:", min = 0, max = 100, value = 50), br(), actionButton("goButton", "Go!"), p("Click the button to update the value displayed in the main panel."), actionButton("newButton", "New Button"), actionButton("newButton2", "Another New Button") ), mainPanel( verbatimTextOutput("nText"), textOutput("some_text_description"), plotOutput("some_plot") ) ) ) server <- function(input, output, session) { # builds a reactive expression that only invalidates #
  • 为什么条形图不根据反应数据框更新?(Why isn't bar plot updating based on reactive data frame?)
    问题
  • Barplot in shiny: when click the actionbutton, the second barplot always appear delay and the previous figure appears
    I create a barplot shiny app. The biggest problem I met now is when I click the acitonbutton to get a new picture , the barplot appear delay and when I choose another input and click actionbutton again, the last barplot will appear but instantly disappear and the second picture appear. But the input first and second time is different. Why the first picture will appear twice? Here is my sample code,it is normal because it's a small sample. library(shiny) library(dplyr) library(tidyr) library(ggplot2) library(gridExtra) mean_data <- data.frame( Name = c(paste0("Group_", LETTERS[1:20])), matx <-
  • 在 R 中下载 Shiny 中的绘图和表格; 从 pickerInput 中选择的表/绘图中进行选择(Download plots and tables in Shiny in R; Choosing from selection of tables/plots in pickerInput)
    问题
  • Shiny App:如何动态更改 server.R 中的框标题?(Shiny App: How to dynamically change box title in server.R?)
    问题 框标题通常在 ui.R 中设置。 是否可以在 server.R 中动态更改框标题? ui.R box(title='Dynamic title here', plotOutput('barPlot')) server.R output$barPlot= renderPlot({...}) # 我可以在这里动态更改框标题吗? 编辑: 这是一个可以尝试的简单代码 ui <- fluidPage( fluidRow( column(width=6, box( title = 'Dynamic title', width = NULL, plotOutput('speed', height='100%') ) ) ) ) server <- function(input, output){ output$speed <- renderPlot({ plot(speed ~ dist, data = cars) # need a code to change the box title }, height=300) } shinyApp(ui=ui, server=server) 回答1 试试这个,使用renderUI : ui <- fluidPage( fluidRow( textInput("title", "What should the tile be?")
  • Selecting record date with selectInput in shiny R
    I am very new to R programming and I am trying to build an shiny r app that takes in data on shark attack data and builds a bar chart that specifies the frequency of a kind of attack e.g. Provoked, Unprovoked, Boating etc. I want to be able to filter by the region however. Here is a sample of the dataset. CaseNumber Year Type Country Area OriginalOrder Region 1642.00.00 1642 Unprovoked USA New York 136 Northeast 1779.00.00 1779 Unprovoked USA Hawaii 152 West 1805.09.00 1805 Invalid USA New York 160 Northeast 1816.09.03 1816 Unprovoked USA Rhode Island 164 Northeast 1817.06.24 1817 Unprovoked
  • 在R / Shiny中缓存图(caching plots in R/Shiny)
    问题 只是想知道是否有技巧/方式可以缓存通过我们闪亮的应用程序生成的图。 背景: 我们正在进行某种程度的计算密集型计算,最终生成了一个图。 我已经在缓存(使用备忘录)中完成的计算,全局上闪闪发光,但渲染图仍需要约0.75秒。 我只是想知道我们是否可以通过消除渲染图像所需的时间来减少该时间,以及是否已经有精巧的方法来完成此操作。 更多细节: 我正在使用网格来创建绘图(在这种情况下为热图。理想情况下,缓存是基于磁盘的,因为将绘图存储在内存中不会扩大规模。 谢谢! -阿比 回答1 假设您使用的是ggplot (对于Shiny,我敢打赌这是一个公平的假设)。 创建一个空列表来存储您的grob,例如Plist 。 当用户请求图形时,根据闪亮的输入创建字符串哈希检查图形是否已经保存,例如hash %in% names(Plist) 如果是,请提供该图表如果否,则生成图形,将grob保存到列表,并通过哈希将元素命名,例如Plist[hash] <- new_graph 回答2 编辑 从闪亮的1.2.0版本开始,支持缓存使用renderPlot()/plotOutput()创建的图像。 发行说明:https://shiny.rstudio.com/reference/shiny/1.2.0/upgrade.html 功能文档https://shiny.rstudio.com/reference
  • R Shiny date slider animation by month (currently by day)
    I'm somewhat comfortable with R, lot less with Shiny, though it's not my first Shiny application. I have a data frame with lon/lat and the date/time of the entry in the system for every new customer. I also created other variables based on the startDate variable like the year, month, week, year-month (ym) and year-week (yw): id lat lon startDate year month week ym yw 1 1 45.53814 -73.63672 2014-04-09 2014 4 15 2014-04-01 2014-04-06 2 2 45.51076 -73.61029 2014-06-04 2014 6 23 2014-06-01 2014-06-01 3 3 45.43560 -73.60100 2014-04-30 2014 4 18 2014-04-01 2014-04-27 4 4 45.54332 -73.56000 2014-05
  • 未显示 R Shiny 传单中点击的表格(Table on click in R Shiny leaflet is not shown)
    问题 我想要一张桌子,点击 Shiny 应用程序中传单地图上的标记。 但: Warning: Error in ==: comparison (1) is possible only for atomic and list types [No stack trace available] 我一次又一次地收到此错误。 这是我的代码。 我猜我的renderTable() 。 botsad.final <- read_csv("https://raw.githubusercontent.com/Janzeero-PhD/Botanical-Garden-of-NULES/master/botsad_final.csv") server <- function(input, output) { # create a reactive value that will store the click position data_of_click <- reactiveValues(clickedMarker=NULL) # Leaflet map output$map <- renderLeaflet({ leaflet() %>% addTiles(options = providerTileOptions(noWrap = TRUE)) %>% addCircleMarkers(data
  • 色相条形图的 Seaborn 解决方法(Seaborn workaround for hue barplot)
    问题 我在Jupyter 笔记本上有以下 DataFrame,它使用 seaborn 条形图绘制: data = {'day_index': [0, 1, 2, 3, 4, 5, 6], 'avg_duration': [708.852242, 676.7021900000001, 684.572677, 708.92534, 781.767476, 1626.575057, 1729.155673], 'trips': [114586, 120936, 118882, 117868, 108036, 43740, 37508]} df = pd.DataFrame(data) daysOfWeek = ['Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday'] plt.figure(figsize=(16,10)); sns.set_style('ticks') ax = sns.barplot(data=df, \ x='day_index', \ y='avg_duration', \ hue='trips', \ palette=sns.color_palette("Reds_d", n_colors=7, desat=1)) ax.set_xlabel("Week Days"