Подсчитать количество дней между указанными двумя датами, сгруппированными по месяцам в таблице - PullRequest
0 голосов
/ 17 сентября 2018

У меня есть набор дат начала и окончания.Я должен рассчитать количество дней в месяц, исключая выходные и праздничные дни.Выходные данные отображаются здесь:

Код становится слишком сложным и не дает правильных результатов.

Код, который я пробовал:

sd ="24-Jan-18"
ed ="4-Mar-18"
sd_m <- ymd(strptime(as.character(sd), format = "%d-%b-%y"))
ed_m <- ymd(strptime(as.character(ed), format = "%d-%b-%y"))
s_m <- format(sd_m, "%b-%Y")
  e_m <-  format(ed_m, "%b-%Y")
  no_months<- (year(ed_m) - year(sd_m)) * 12 + month(ed_m) - month(sd_m) +1
  i = 0
  day_count = as.vector(0)
  e_mon = as.Date(seq(as.yearmon(sd_m),as.yearmon(ed_m),1/12),frac = 1)
  s_mon =   as.Date(seq(as.yearmon(sd_m),as.yearmon(ed_m),1/12),frac = 0)
  day_count[1]= = sum(!weekdays(seq(sd_m ,e_mon[1], "days")) %in% c('Saturday', 'Sunday')) -holiday
  i=2
  for (i in 1:(no_months-1)){
   day_count[i]= sum(!weekdays(seq(s_mon[i], e_mon[i], "days")) %in% c('Saturday', 'Sunday')) -holiday } 
  day_count[no_months] = sum(!weekdays(seq(s_mon[no_months],ed_m, "days")) %in% c('Saturday', 'Sunday')) -holiday

И для подсчета праздников я подумывал написать цикл for, который не помогает.hol =c("2018-01-26" "2018-05-01" "2018-08-15" "2018-09-13" "2018-10-02" "2018-12-25")

Я пытался использовать bizdays create.calendar(name ='my_cal', holidays = hol1,weekdays = c('Saturday', 'Sunday'))

Но выдает ошибку:

bizdays(sd_m,e_mon[1],my_cal)
Error in check_calendar(cal) : object 'my_cal' not found

Пожалуйста, помогите построить !!

Ответы [ 2 ]

0 голосов
/ 17 сентября 2018

Вот базовое решение. Использование входных данных, воспроизводимых в примечании в конце toLong, создает фрейм данных d с одной строкой на дату и удаляет из нее выходные и праздничные дни. Затем он агрегирует это по годам и месяцам. Это применяется к каждой строке ввода, давая список L фреймов данных, которые rbind объединены вместе. Наконец, это преобразуется в широкую форму. Последняя строка кода может быть опущена, если имена столбцов в формате гггг-мм в порядке.

toLong <- function(row, sd, ed, hol) {
  s <- seq(sd, ed, "day")
  d <- data.frame(row, s, ym = format(s, "%Y-%m"))
  d <- subset(d, ! weekdays(s) %in% c("Saturday", "Sunday"))
  d <- subset(d, ! s %in% hol)
  data.frame(row, sd, ed, aggregate(s ~ ym, d, FUN = length))
}

L <- Map(toLong, 1:nrow(DF), DF$sd, DF$ed, MoreArgs = list(hol = hol))
DF2 <- do.call("rbind", L)
xt <- xtabs(s ~ row + ym, DF2)
DF3 <- cbind(DF, as.data.frame.matrix(xt))
names(DF3)[-(1:2)] <- format(as.Date(paste0(names(DF3)[-(1:2)], "-01")), "%b %Y")

дает:

> DF3
          sd         ed Oct 2018 Nov 2018 Jan 2018 Feb 2018 Mar 2018
1 2018-10-01 2018-11-01       23        1        0        0        0
2 2018-01-24 2018-03-04        0        0        6       20        2

Примечание

Вводимый в воспроизводимый от:

DF <-
  structure(list(sd = structure(c(17805, 17555), class = "Date"), 
    ed = structure(c(17836, 17594), class = "Date")), row.names = c(NA, 
  -2L), class = "data.frame")

hol <- as.Date(c("2018-01-26", "2018-05-01", "2018-08-15", "2018-09-13", 
  "2018-10-02", "2018-12-25"))
0 голосов
/ 17 сентября 2018

Tidyverse подход с использованием некоторых lubridate функций

sd ="2018-01-24"
ed ="2018-03-04"

#create a data.frame with all days from startdata (sd) to end date (ed)
df <- data.frame( dates = seq( as.Date(sd), as.Date(ed), by = "days"))

#create the vector with Holiday-dates
holidays_v <- as.Date( c("2018-01-26", "2018-05-01", "2018-08-15", "2018-09-13", "2018-10-02", "2018-12-25") )

library(tidyverse)

df %>% 
  #filter out all days that are Sundays (wday == 1), or Saturdays (wday == 7), of within the vector with Holidays
  filter( !lubridate::wday( dates ) %in% c(1,7) & !dates %in% holidays_v ) %>%
  #create period to summarise by (here: year-month)
  mutate( period = paste( lubridate::year(dates), formatC(lubridate::month(dates), width = 2, format = "d", flag = "0"), sep = "-") ) %>%
  # group by period
  group_by( period ) %>%
  #... and summarise
  summarise( number = n() )

# # A tibble: 3 x 2
#   period  number
#   <chr>    <int>
# 1 2018-01      5
# 2 2018-02     20
# 3 2018-03      2
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...