首页 > 解决方案 > 在闪亮的 R 中绘制每月百分比

问题描述

我有一个闪亮的应用程序,它在闪亮的仪表板中有四个不同的图。我希望所有的图都是基于当年的滑块输入的。我让它工作得非常好......但是,我希望其中一个图在 x 轴上有几个月,而不是像其他年份那样的年份,但仍然对年份滑块输入具有反应性,并相应地过滤数据框。我也让它工作,但我似乎无法弄清楚如何将月份从数字更改为 x 轴上的实际月份名称。

这就是我想要的(不像箱线图只想要x轴):

在此处输入图像描述

样本数据:

    df1<-structure(list(stdate = structure(c(16611, 16611, 16611, 16615, 
16615, 16615, 14004, 14004, 14004, 16616, 16616, 16616, 16616, 
16616, 16616, 17485, 17483, 16678, 14000, 14000, 14000, 17211, 
17210, 16615, 16611, 16756, 14098, 16674, 16674, 14096), class = "Date"), 
    sttime = structure(c(37800, 37800, 37800, 35100, 35100, 35100, 
    42600, 42600, 42600, 38700, 38700, 38700, 32400, 32400, 32400, 
    35400, 33000, 49800, 34200, 34200, 34200, 37800, 30600, 35100, 
    37800, 37800, 35400, 37800, 32400, 37200), class = c("hms", 
    "difftime"), units = "secs"), locid = c("USGS-01388500", 
    "USGS-01388500", "USGS-01388500", "USGS-01464585", "USGS-01464585", 
    "USGS-01464585", "USGS-01464515", "USGS-01464515", "USGS-01464515", 
    "USGS-01407330", "USGS-01407330", "USGS-01407330", "USGS-01466500", 
    "USGS-01466500", "USGS-01466500", "USGS-01387500", "USGS-01395000", 
    "USGS-01400860", "USGS-01377000", "USGS-01377000", "USGS-01377000", 
    "USGS-01367625", "USGS-01398000", "USGS-01464585", "USGS-01388500", 
    "USGS-01390630", "USGS-01396090", "USGS-01407810", "USGS-01407821", 
    "USGS-01391540"), charnam = c("Chloride", "Total dissolved solids", 
    "Specific conductance", "Chloride", "Total dissolved solids", 
    "Specific conductance", "Specific conductance", "Total dissolved solids", 
    "Chloride", "Chloride", "Total dissolved solids", "Specific conductance", 
    "Chloride", "Total dissolved solids", "Specific conductance", 
    "Specific conductance", "Specific conductance", "Specific conductance", 
    "Specific conductance", "Total dissolved solids", "Chloride", 
    "Specific conductance", "Specific conductance", "Total dissolved solids", 
    "Total dissolved solids", "Total dissolved solids", "Specific conductance", 
    "Specific conductance", "Specific conductance", "Specific conductance"
    ), val = c(109, 294, 525, 31.9, 119, 184, 226, 155, 33, 36.4, 
    155, 203, 3.38, 43, 41, 674, 466, 312, 540, 328, 105, 844, 
    683, 100, 275, 432, 342, 200, 237, 805), valunit = c("mg/l", 
    "mg/l", "uS/cm @25C", "mg/l", "mg/l", "uS/cm @25C", "uS/cm @25C", 
    "mg/l", "mg/l", "mg/l", "mg/l", "uS/cm @25C", "mg/l", "mg/l", 
    "uS/cm @25C", "uS/cm @25C", "uS/cm @25C", "uS/cm @25C", "uS/cm @25C", 
    "mg/l", "mg/l", "uS/cm @25C", "uS/cm @25C", "mg/l", "mg/l", 
    "mg/l", "uS/cm @25C", "uS/cm @25C", "uS/cm @25C", "uS/cm @25C"
    ), LatDeg = c(40.969722, 40.969722, 40.969722, 40.041667, 
    40.041667, 40.041667, 40.176944, 40.176944, 40.176944, 40.319167, 
    40.319167, 40.319167, 39.885, 39.885, 39.885, 41.098056, 
    40.618889, 40.418333, 40.999167, 40.999167, 40.999167, 41.040278, 
    40.473333, 40.041667, 40.969722, NA, 40.860556, 40.2075, 
    40.211667, 40.867778), LongDeg = c(-74.281944, -74.281944, 
    -74.281944, -74.766944, -74.766944, -74.766944, -74.598889, 
    -74.598889, -74.598889, -74.160556, -74.160556, -74.160556, 
    -74.505278, -74.505278, -74.505278, -74.162778, -74.283333, 
    -74.787222, -73.989167, -73.989167, -73.989167, -74.629722, 
    -74.827778, -74.766944, -74.281944, NA, -74.76, -74.328889, 
    -74.295833, -74.094722), HUC14 = c("HUC02030103110020", "HUC02030103110020", 
    "HUC02030103110020", "HUC02040201100030", "HUC02040201100030", 
    "HUC02040201100030", "HUC02040201060020", "HUC02040201060020", 
    "HUC02040201060020", "HUC02030104070070", "HUC02030104070070", 
    "HUC02030104070070", "HUC02040202030070", "HUC02040202030070", 
    "HUC02040202030070", "HUC02030103100030", "HUC02030104050060", 
    "HUC02030105090020", "HUC02030103170060", "HUC02030103170060", 
    "HUC02030103170060", "HUC02020007010010", "HUC02030105030060", 
    "HUC02040201100030", "HUC02030103110020", NA, "HUC02030105010040", 
    "HUC02030104100010", "HUC02030104100010", "HUC02030103140070"
    ), WMA = c(3L, 3L, 3L, 20L, 20L, 20L, 20L, 20L, 20L, 12L, 
    12L, 12L, 19L, 19L, 19L, 3L, 7L, 10L, 5L, 5L, 5L, 2L, 8L, 
    20L, 3L, NA, 8L, 12L, 12L, 4L), year = c(2015, 2015, 2015, 
    2015, 2015, 2015, 2008, 2008, 2008, 2015, 2015, 2015, 2015, 
    2015, 2015, 2017, 2017, 2015, 2008, 2008, 2008, 2017, 2017, 
    2015, 2015, 2015, 2008, 2015, 2015, 2008), month = c(6, 6, 
    6, 6, 6, 6, 5, 5, 5, 6, 6, 6, 6, 6, 6, 11, 11, 8, 5, 5, 5, 
    2, 2, 6, 6, 11, 8, 8, 8, 8)), .Names = c("stdate", "sttime", 
"locid", "charnam", "val", "valunit", "LatDeg", "LongDeg", "HUC14", 
"WMA", "year", "month"), row.names = c(NA, -30L), class = c("tbl_df", 
"tbl", "data.frame"))

我试过的:

parameters<-unique(df1$charnam)


sidebar<-dashboardSidebar(
  selectInput("parameter_input","Select Parameter",
              parameters,selected = "Chloride"),
  sliderInput("date","Select Year Range",
              min = min(df1$year),
              max = max(df1$year),
              value = c(min,max),
              sep = "",
              step = 1)
)
header<-dashboardHeader()
body<- dashboardBody(
          box(plotOutput("plot1")))

ui<-dashboardPage(header=header,
                  sidebar = sidebar,
                  body = body)



server<- function(input,output,session){

  month_percent_over<-reactive({
      df1%>%
        filter(charnam == input$parameter_input)%>%
        mutate(val = as.numeric(val),greater = val >230) %>%
        group_by(month,year) %>%
        summarize(n_greater = sum(greater),percentage=mean(greater)*100)%>%
        filter(year >= input$date[1])%>%
        filter(year <= input$date[2])

  }) 




### Creates % > Standard month plots ###
output$plot1<- renderPlot({
    ggplot(data = month_percent_over(),aes(x=month,y = percentage))+
      geom_point(aes(colour="blue"),size=3,stat = "identity")+
      geom_smooth(method = "lm", se=FALSE,linetype = "dashed",aes(y=percentage,colour="red"))+
      scale_color_manual("",
                         #breaks= c("per"),
                         values = c("blue","red"),
                         labels=c("% Samples > Standard","Trendline"),
                         guide=guide_legend(override.aes=list(linetype=c(0,2), lwd=c(3,0.5))))+
      scale_x_discrete(labels=c("1" = "January", "2" = "Feburary",
                                "3" = "March","4"="April","5"="May",
                                "6"="June","7"="July",
                                "8"="August","9"="September","10"="October",
                                "11"="November","12"="December"))


})
}
shinyApp(ui,server)

标签: rggplot2shinyshinydashboard

解决方案


推荐阅读