【问题标题】:Adjust Error when showing scatter plot in Shiny在 Shiny 中显示散点图时调整错误
【发布时间】:2021-08-27 23:03:01
【问题描述】:

你能帮我调整一下我的代码吗?我试图让我的散点图看起来有光泽。但是,它不起作用。功能还可以,但是我不能在 Shiny 上显示。

欢迎任何帮助。

非常感谢!

rm(list=ls())
library(shiny)
library(shinythemes)
library(dplyr)
library(ggplot2)
library(tidyr)
library(lubridate)

function.cl<-function(dt){

  df <- structure(
    list(Id=c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
         date1 = c("2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
                   "2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
                   "2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
                   "2021-07-20","2021-07-20","2021-07-20","2021-07-20"),
         date2 = c("2021-07-01","2021-07-01","2021-07-01","2021-07-01","2021-04-02",
                   "2021-04-02","2021-04-02","2021-04-02","2021-04-02","2021-04-02","2021-04-03",
                   "2021-04-03","2021-04-03","2021-04-03","2021-04-03","2021-04-08","2021-04-08",
                   "2021-04-09","2021-04-09","2021-04-10","2021-04-10"),
         Week= c("Thursday","Thursday","Thursday","Thursday","Friday","Friday","Friday","Friday",
                 "Friday","Friday","Saturday","Saturday","Saturday","Saturday","Saturday","Thursday",
                 "Thursday","Friday","Friday","Saturday","Saturday"),
         D = c("","","Ho","","","","","","Ho","","","","","","","","","","","",""), 
                 D1 = c(8,1,9, 3,5,4,7,6,3,8,2,3,4,6,7,8,4,2,6,2,3), DR01 = c(4,1,4,3,3,4,3,6,3,7,2,3,4,6,7,8,4,2,6,7,3),
                 DR2 = c(2,1,4,3,3,4,1,6,3,7,2,3,4,6,7,8,4,2,6,2,3), DR03 = c(7,5,4,3,3,4,1,5,3,3,2,3,4,6,7,8,4,2,6,4,3)),
            class = "data.frame", row.names = c(NA, -21L))
  
  
  df<-subset(df,df$date2<df$date1) 
  
  dim_data<-dim(df)
  
  day<-c(seq.Date(from = as.Date(df$date2[1]),
                  to = as.Date(df$date2[dim_data[1]]),
                  by = "1 day"))
  
  df_grouped <- df %>%
    mutate(across(starts_with("date"), as.Date)) %>% 
    group_by(date2) %>% 
    summarise(Id = first(Id),
              date1 = first(date1),
              Week = first(Week),
              D = first(D),
              D1 = sum(D1)) %>% 
    select(Id,date1,date2,Week,D,D1)
  
  df_grouped <- df_grouped %>% mutate(date1=format(date1,"%d/%m/%Y"),
                                      date2=format(date2,"%d/%m/%Y"))
  df_grouped<-data.frame(df_grouped)
  df_grouped

  
  #create scatter plot
  scatter_date <- function(dt, dta = df) {
    
    # get the week day
    my_day <- weekdays(as.Date(dt))
    
    df_OC<-subset(df_grouped,is.na(D)) 
    ds_OC<-subset(df_OC,df_OC$Week==my_day) 
    
    
    mean_Week<-mean(as.numeric(ds_OC[,"D1"]) )
    sdeviation_Week<-sd(as.numeric(ds_OC[,"D1"]))
    
    
    mean_Week_pos <- (mean_Week + sdeviation_Week)
    mean_Week_neg <- (mean_Week - sdeviation_Week)
    
    dta %>%
      filter(date2 == ymd(dt)) %>%
      summarize(across(starts_with("DR"), sum)) %>%
      pivot_longer(everything(), names_pattern = "DR(.+)", values_to = "val") %>%
      mutate(name = as.numeric(name)) %>%
      plot(xlab = "Days", ylab = "Types", xlim = c(0, 7),
           ylim = c((min(.$val) %/% 10) * 10, (max(.$val) %/% 10 + 1) * 15))
    abline(h=mean_Week, col='blue') 
    abline(h= mean_Week_pos, col='green',lty=2) 
    abline(h= mean_Week_neg, col='orange',lty=2)
    
    
  }  
  #scatter_date("2021-07-01",df)
  Plot1<-scatter_date(dt)
  
  return(list(
    "Plot1" = Plot1, 
    date = df$date
  ))
}

ui <- fluidPage(
  
  ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                          br(),
                          
                          tabPanel("",
                                   sidebarLayout(
                                     sidebarPanel(
                                       
                                       uiOutput("date"),
                                       
                                       br(),
                                     ),
                                     
                                     mainPanel(
                                       tabsetPanel(
                                         tabPanel("",plotOutput("Graph",width = "95%", height = "600"))),
                                     ))
                          )))


server <- function(input, output,session) {
  data <- reactive(function.cl("2021-07-01"))
  
  output$date <- renderUI({
    all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
    disabled <- as.Date(setdiff(all_dates, as.Date(data()$date)), origin = "1970-01-01")
    dateInput(input = "date", 
              label = "Select Date",
              min = min(data()$date),
              max = max(data()$date),
              value = max(data()$date),
              format = "dd-mm-yyyy",
              datesdisabled = disabled)
  })
  
  output$Graph <- renderPlot({
    req(input$date)
    function.cl(input$date)[["Plot1"]]
    
  })
  
  
  
}

shinyApp(ui = ui, server = server)

不显示水平线

【问题讨论】:

    标签: r shiny


    【解决方案1】:

    您的函数存在一些问题。试试这个

    function.cl<-function(dt){
      
      df <- structure(
        list(Id=c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
             date1 = c("2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
                       "2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
                       "2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20","2021-07-20",
                       "2021-07-20","2021-07-20","2021-07-20","2021-07-20"),
             date2 = c("2021-07-01","2021-07-01","2021-07-01","2021-07-01","2021-04-02",
                       "2021-04-02","2021-04-02","2021-04-02","2021-04-02","2021-04-02","2021-04-03",
                       "2021-04-03","2021-04-03","2021-04-03","2021-04-03","2021-04-08","2021-04-08",
                       "2021-04-09","2021-04-09","2021-04-10","2021-04-10"),
             Week= c("Thursday","Thursday","Thursday","Thursday","Friday","Friday","Friday","Friday",
                     "Friday","Friday","Saturday","Saturday","Saturday","Saturday","Saturday","Thursday",
                     "Thursday","Friday","Friday","Saturday","Saturday"),
             D = c("","","Ho","","","","","","Ho","","","","","","","","","","","",""), 
             D1 = c(8,1,9, 3,5,4,7,6,3,8,2,3,4,6,7,8,4,2,6,2,3), DR01 = c(4,1,4,3,3,4,3,6,3,7,2,3,4,6,7,8,4,2,6,7,3),
             DR2 = c(2,1,4,3,3,4,1,6,3,7,2,3,4,6,7,8,4,2,6,2,3), DR03 = c(7,5,4,3,3,4,1,5,3,3,2,3,4,6,7,8,4,2,6,4,3)),
        class = "data.frame", row.names = c(NA, -21L))
      
      
      df<-subset(df,df$date2<df$date1) 
      
      dim_data<-dim(df)
      
      day<-c(seq.Date(from = as.Date(df$date2[1]), by = "days",
                      length = dim_data[1]
      ))  ###<---------  issue here
      
      df_grouped <- df %>%
        mutate(across(starts_with("date"), as.Date)) %>% 
        group_by(date2) %>% 
        summarise(Id = first(Id),
                  date1 = first(date1),
                  Week = first(Week),
                  D = first(D),
                  D1 = sum(D1)) %>% 
        select(Id,date1,date2,Week,D,D1)
      
      df_grouped <- df_grouped %>% mutate(date1=format(date1,"%d/%m/%Y"),
                                          date2=format(date2,"%d/%m/%Y"))
      df_grouped<-data.frame(df_grouped)
      df_grouped
      
      
      #create scatter plot
      scatter_date <- function(dt, dta = df) {
        
        # get the week day
        my_day <- weekdays(as.Date(dt))
        
        df_OC<-subset(df_grouped,is.na(D) | D=="") ###<-----------  issue here
        ds_OC<-subset(df_OC,df_OC$Week==my_day) 
        
        
        mean_Week<-mean(as.numeric(ds_OC[,"D1"]) )
        sdeviation_Week<-sd(as.numeric(ds_OC[,"D1"]))
        
        
        mean_Week_pos <- (mean_Week + sdeviation_Week)
        mean_Week_neg <- (mean_Week - sdeviation_Week)
        
        dta %>%
          filter(date2 == ymd(dt)) %>%
          summarize(across(starts_with("DR"), sum)) %>%
          pivot_longer(everything(), names_pattern = "DR(.+)", values_to = "val") %>%
          mutate(name = as.numeric(name)) %>%
          plot(xlab = "Days", ylab = "Types", xlim = c(0, 7),
               ylim = c((min(.$val) %/% 10) * 10, (max(.$val) %/% 10 + 1) * 15))
        abline(h=mean_Week, col='blue') 
        abline(h= mean_Week_pos, col='green',lty=2) 
        abline(h= mean_Week_neg, col='orange',lty=2)
        
        
      }
      #scatter_date("2021-07-01",df)
      Plot1<-scatter_date(dt)
      
      return(list(
        "Plot1" = Plot1, 
        date = df$date
      ))
    }
    

    【讨论】:

    • 优秀的 YBS!我得到了你的代码并且散点图有效,只有水平线无效。你知道原因吗?
    • YBS,我在问题中插入了一个数字供您查看,很奇怪,因为您的工作。是缺少包更新还是什么?
    • YBS,感谢您的回复。我会接受你的回答。我问了一个关于这个错误的新问题*.com/questions/68956726/…
    • 请注意,我没有使用任何额外的包。您应该重新启动笔记本电脑或重新启动 RStudio。这可能有助于解决您的问题。