简体   繁体   中英

Adjust Error when showing scatter plot in Shiny

Could you help me tweak my code?. I'm trying to make my scatter chart appear shiny. However, it's not working. The function is ok, however I can't show it on Shiny.

Any help is welcome.

Thank you very much!

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)

Horizontal lines are not shown在此处输入图片说明

Your function had a few issues. Try this

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
  ))
}

输出

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM