Graph being generated for all categories-CodePudding

Could you help me solve the following issue: the code below generates a graph with dots and a "prediction" line so to speak. As you can see, the graph is plotting the points of all categories for the day 09/07, however, I specify just to FGE. In addition the title of graph needs to be adjusted.

library(dplyr)
library(tidyverse)
library(lubridate)


df1 <- structure(
  list(date1= c("2021-06-28","2021-06-28","2021-06-28","2021-06-28","2021-06-28",
                "2021-06-28","2021-06-28","2021-06-28"),
       date2 = c("2021-06-30","2021-06-30","2021-07-02","2021-07-07","2021-07-07","2021-07-09","2021-07-09","2021-07-09"),
       Code = c("FDE","ABC","ABC","ABC","CDE","FGE","ABC","CDE"),
       Week= c("Wednesday","Wednesday","Friday","Wednesday","Wednesday","Friday","Friday","Friday"),
       DR1 = c(4,1,4,3,3,4,3,5),
       DR01 = c(4,1,4,3,3,4,3,6), DR02= c(4,2,6,7,3,2,7,4),DR03= c(9,5,4,3,3,2,1,5),
       DR04 = c(5,4,3,3,6,2,1,9),DR05 = c(5,4,5,3,6,2,1,9),
       DR06 = c(2,4,3,3,5,6,7,8),DR07 = c(2,5,4,4,9,4,7,8),
       DR08 = c(0,0,0,1,2,0,0,0),DR09 = c(0,0,0,0,0,0,0,0),DR010 = c(0,0,0,0,0,0,0,0),DR011 = c(4,0,0,0,0,0,0,0), 
       DR012 = c(0,0,0,3,0,0,0,5),DR013 = c(0,0,1,0,0,0,2,0),DR014 = c(0,0,0,0,0,2,0,0)),
  class = "data.frame", row.names = c(NA, -8L))


f1 <- function(dmda, CodeChosse) {

dmda<-"2021-07-09"
CodeChosse<-"FGE"

x<-df1 %>% select(starts_with("DR0"))

x<-cbind(df1, setNames(df1$DR1 - x, paste0(names(x), "_PV")))
PV<-select(x, date2,Week, Code, DR1, ends_with("PV"))

med<-PV %>%
  group_by(Code,Week) %>%
  summarize(across(ends_with("PV"), median))

SPV<-df1%>%
  inner_join(med, by = c('Code', 'Week')) %>%
  mutate(across(matches("^DR0\\d $"), ~.x   
                  get(paste0(cur_column(), '_PV')),
                .names = '{col}_{col}_PV')) %>%
  select(date1:Code, DR01_DR01_PV:last_col())

SPV<-data.frame(SPV)


mat1 <- df1 %>%
  filter(date2 == dmda, Code == CodeChosse) %>%
  select(starts_with("DR0")) %>%
  pivot_longer(cols = everything()) %>%
  arrange(desc(row_number())) %>%
  mutate(cs = cumsum(value)) %>%
  filter(cs == 0) %>%
  pull(name)

(dropnames <- paste0(mat1,"_",mat1, "_PV"))

SPV %>%
  filter(date2 == dmda, Code == CodeChosse) %>%
  select(-any_of(dropnames))

datas<-SPV %>%
  filter(date2 == ymd(dmda)) %>%
  group_by(Code) %>%
  summarize(across(starts_with("DR0"), sum)) %>%
  pivot_longer(cols= -Code, names_pattern = "DR0(. )", values_to = "val") %>%
  mutate(name = readr::parse_number(name))
colnames(datas)[-1]<-c("Days","Numbers")

datas <- datas %>% 
  group_by(Code) %>% 
  slice((as.Date(dmda) - min(as.Date(df1$date1) [
    df1$Code == first(Code)])):max(Days) 1) %>%
  ungroup

# Plot graph, dots and point

   plot(Numbers ~ Days,  xlim= c(0,45), ylim= c(0,30),
       xaxs='i',data = datas,main = paste0(dmda, "-", Code))
   model <- nls(Numbers ~ b1*Days^2 b2,start = list(b1 = 0,b2 = 0),data = datas, algorithm = "port")
    
  new.data <- data.frame(Days = with(datas, seq(min(Days),max(Days),len = 45)))
  new.data <- rbind(0, new.data)
  lines(new.data$Days,predict(model,newdata = new.data),lwd=2)
    coef<-coef(model)[2]
    points(0, coef, col="red",pch=19,cex = 2,xpd=TRUE)
    text(.99,coef   1,max(0, round(coef,1)), cex=1.1,pos=4,offset =1,col="black")}
  
}

f1(datas, CodeChosse)

CodePudding user response：

Where you have filtered SPV using Code == CodeChosse the results are not assigned to anything. If you want to filter for Codechosse then you need to assign the results to SPV (or something else).

SPV <- SPV %>%
  filter(date2 == dmda, Code == CodeChosse) %>%
  select(-any_of(dropnames))