R: Как получить номер недели месяца

Ответ 1

Вы можете использовать day из пакета lubridate. Я не уверен, есть ли в пакете функция типа "неделя месяца", но мы можем сделать математику.

library(lubridate)
curr <- Sys.Date()
# [1] "2014-08-08"
day(curr)               ## 8th day of the current month
# [1] 8
day(curr) / 7           ## Technically, it the 1.14th week
# [1] 1.142857
ceiling(day(curr) / 7)  ## but ceiling() will take it up to the 2nd week.
# [1] 2

Ответ 2

По аналогии с функцией weekdays:

monthweeks <- function(x) {
    UseMethod("monthweeks")
}
monthweeks.Date <- function(x) {
    ceiling(as.numeric(format(x, "%d")) / 7)
}
monthweeks.POSIXlt <- function(x) {
    ceiling(as.numeric(format(x, "%d")) / 7)
}
monthweeks.character <- function(x) {
    ceiling(as.numeric(format(as.Date(x), "%d")) / 7)
}
dates <- sample(seq(as.Date("2000-01-01"), as.Date("2015-01-01"), "days"), 7)
dates
#> [1] "2004-09-24" "2002-11-21" "2011-08-13" "2008-09-23" "2000-08-10" "2007-09-10" "2013-04-16"
monthweeks(dates)
#> [1] 4 3 2 4 2 2 3

Другое решение использовать stri_datetime_fields() из пакета stringi:

stringi::stri_datetime_fields(dates)$WeekOfMonth
#> [1] 4 4 2 4 2 3 3

Ответ 3

Я не знаю R, но если вы возьмете неделю в первый день месяца, вы можете использовать ее, чтобы получить неделю в месяце

2014-09-18
First day of month = 2014-09-01
Week of first day on month = 36
Week of 2014-09-18 = 38
Week in the month = 1 + (38 - 36) = 3

Ответ 4

Используя lubridate, вы можете сделать

ceiling((day(date) + first_day_of_month_wday(date) - 1) / 7)

Если функция first_day_of_month_wday возвращает день недели в первый день месяца.

first_day_of_month_wday <- function(dx) {
  day(dx) <- 1
  wday(dx)
}

Эта настройка должна быть выполнена, чтобы получить правильный номер недели, если у вас есть 7-й день месяца в понедельник, вы получите 1 вместо 2, например. Это только сдвиг в день месяца. Минус 1 необходим, потому что, когда первый день месяца воскресен, настройка не требуется, а остальные дни недели следуют этому правилу.

Ответ 5

Я столкнулся с той же проблемой, и решил ее с помощью пакета mday из data.table. Кроме того, я понял, что при использовании функции ceiling() также необходимо учитывать ситуацию "5-й недели". Например, ceiling 30-го числа месяца ceiling(30/7) даст 5! Поэтому приведенный ниже оператор ifelse.

# Create a sample data table with days from year 0 until present
DT <- data.table(days = seq(as.Date("0-01-01"), Sys.Date(), "days"))
# compute the week of the month and account for the '5th week' case
DT[, week := ifelse( ceiling(mday(days)/7)==5, 4, ceiling(mday(days)/7) )]

> DT
              days week
     1: 0000-01-01    1
     2: 0000-01-02    1
     3: 0000-01-03    1
     4: 0000-01-04    1
     5: 0000-01-05    1
    ---                
736617: 2016-10-14    2
736618: 2016-10-15    3
736619: 2016-10-16    3
736620: 2016-10-17    3
736621: 2016-10-18    3

Чтобы узнать о скорости, запустите:

system.time( DT[, week := ifelse( ceiling(mday(days)/7)==5, 4, ceiling(mday(days)/7) )] )
   # user  system elapsed 
   # 3.23    0.05    3.27

Прошло ок. 3 секунды для расчета недель более чем на 700 000 дней.

Однако вышеописанный способ ceiling всегда будет создавать последнюю неделю дольше, чем все остальные недели (четыре недели - 7,7,7 и 9 или 10 дней). Другой способ - использовать что-то вроде

ceiling(1:31/31*4)
 [1] 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4

где вы получаете 7, 8, 8 и 8 дней за соответствующую неделю в течение 31 дня.

DT[, week2 := ceiling(mday(days)/31*4)]

Ответ 6

Есть простой способ сделать это с помощью пакета lubridate:

isoweek() возвращает неделю так, как это выглядит в системе ISO 8601, которая использует повторяющуюся високосную неделю.

epiweek() - версия эпидемиологической недели, представленная в CDC США. Следует тем же правилам, что и isoweek(), но начинается в воскресенье. В других частях света конвенция должна начинать эпидемиологические недели в понедельник, что аналогично isoweek().

Ссылка здесь

Ответ 7

Я не знаю каких-либо встроенных функций, но обходной путь был бы

CurrentDate <- Sys.Date()
# The number of the week relative to the year
weeknum <- as.integer( format(CurrentDate, format="%U") )

# Find the minimum week of the month relative to the year
mindatemonth <- as.Date( paste0(format(CurrentDate, "%Y-%m"), "-01") )
weeknummin <- as.integer( format(mindatemonth, format="%U") ) # the number of the week of the first week within the month

# Calculate the number of the week relative to the month
weeknum <- weeknum - (weeknummin - 1) # this is as an integer

# With the following you can convert the integer to the same format of 
# format(CurrentDate, format="%U")
formatC(weeknum, width = 2, flag = "0")

Ответ 8

Обзор проблемы

Трудно было сказать, какие ответы сработали, поэтому я построил свою собственную функцию nth_week и проверил ее в сравнении с другими.

Проблема, которая приводит к неправильным ответам, заключается в следующем:

• Первая неделя месяца часто бывает короткой
• То же самое с последней неделей месяца

Например, 1 октября 2019 года - вторник, поэтому 6 дней октября (то есть воскресенье) уже вторая неделя. Кроме того, смежные месяцы часто делят одну и ту же неделю в соответствующих количествах, что означает, что последняя неделя предыдущего месяца обычно также является первой неделей текущего месяца. Поэтому следует ожидать, что число недель превышает 52 в год, а в некоторые месяцы - 6 недель.

Сравнение результатов

Вот таблица, показывающая примеры, в которых некоторые из предложенных выше алгоритмов не работают:

DATE            Tori user206 Scri Klev Stringi Grot Frei Vale epi iso coni
Fri-2016-01-01    1     1      1   1      5      1    1    1    1   1   1
Sat-2016-01-02    1     1      1   1      1      1    1    1    1   1   1
Sun-2016-01-03    2     1      1   1      1      2    2    1  -50   1   2
Mon-2016-01-04    2     1      1   1      2      2    2    1  -50 -51   2
Sat-2018-12-29    5     5      5   5      5      5    5    4    5   5   5
Sun-2018-12-30    6     5      5   5      5      6    6    4  -46   5   6
Mon-2018-12-31    6     5      5   5      6      6    6    4  -46 -46   6
Tue-2019-01-01    1     1      1   1      6      1    1    1    1   1   1

Вы можете видеть, что Grothendieck, conighion, Freitas и my являются правильными для неполных периодов недели. Я сравнил все дни от 100 до 3000 года - никаких различий между этими 4. (Stringi, вероятно, подходит для обозначения выходных как отдельных увеличенных периодов, но я не проверял, чтобы быть уверенным; epiweek() и isoweek() из-за их предполагаемого использования покажите некоторое странное поведение в конце года при использовании их для увеличения недели.)

Сравнение скорости

Ниже приведены тесты эффективности между: Tori, Grothendieck, Conighion и Freitas

# prep
library(lubridate)
library(tictoc)

kepler<- ymd(15711227) # Kepler birthday since it a nice day to start with
some_dates<- seq(kepler, today(), by='day')

# test speed of Tori algorithm
tic(msg = 'Tori')
Tori<- (5 + day(some_dates) + wday(floor_date(some_dates, 'month'))) %/% 7
toc()
Tori: 0.19 sec elapsed

# test speed of Grothendieck algorithm
wk <- function(x) as.numeric(format(x, "%U"))
tic(msg = 'Grothendieck')
Grothendieck<- (wk(some_dates) - wk(as.Date(cut(some_dates, "month"))) + 1)
toc()
Grothendieck: 1.99 sec elapsed

# test speed of conighion algorithm
tic(msg = 'conighion')
weeknum <- as.integer( format(some_dates, format="%U") )
mindatemonth <- as.Date( paste0(format(some_dates, "%Y-%m"), "-01") )
weeknummin <- as.integer( format(mindatemonth, format="%U") ) # the number of the week of the first week within the month
conighion <- weeknum - (weeknummin - 1) # this is as an integer
toc()
conighion: 2.42 sec elapsed

# test speed of Freitas algorithm
first_day_of_month_wday <- function(dx) {
   day(dx) <- 1
   wday(dx)
 }
tic(msg = 'Freitas')
Freitas<- ceiling((day(some_dates) + first_day_of_month_wday(some_dates) - 1) / 7)
toc()
Freitas: 0.97 sec elapsed

Самый быстрый правильный алгоритм примерно в 5 раз, следующий ближайший

require(lubridate) some_dates<- seq(ymd(20190101), today(), 'day') (5 + day(some_dates) wday(floor_date(some_dates, 'month'))) %>

Реализация функции

Я также написал для него обобщенную функцию, которая выполняет подсчет недель по месяцам или годам, начинается в день, который вы выбираете, например, например, вы хотите начать свою неделю в понедельник, выводить метки для легкой проверки и все еще очень быстро благодаря lubridate.

nth_week<- function(dates = NULL,
                    count_weeks_in = c("month","year"),
                    begin_week_on = "Sunday"){

  require(lubridate)

  count_weeks_in<- tolower(count_weeks_in[1])

  # day_names and day_index are for beginning the week on a day other than Sunday
  # (this vector ordering matters, so careful about changing it)
  day_names<- c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday")

  # index integer of first match
  day_index<- pmatch(tolower(begin_week_on),
                     tolower(day_names))[1]


  ### Calculate week index of each day

  if (!is.na(pmatch(count_weeks_in, "year"))) {

    # For year:
    # sum the day of year, index for day of week at start of year, and constant 5 
    #  then integer divide quantity by 7   
    # (explicit on package so lubridate and data.table don't fight)
    n_week<- (5 + 
                lubridate::yday(dates) + 
                lubridate::wday(floor_date(dates, 'year'), 
                                week_start = day_index)
    ) %/% 7

  } else {

    # For month:
    # same algorithm as above, but for month rather than year
    n_week<- (5 + 
                lubridate::day(dates) + 
                lubridate::wday(floor_date(dates, 'month'), 
                                week_start = day_index)
    ) %/% 7

  }

  # naming very helpful for review
  names(n_week)<- paste0(lubridate::wday(dates,T), '-', dates)

  n_week

}

Выход функции

# Example raw vector output: 
some_dates<- seq(ymd(20190930), today(), by='day')
nth_week(some_dates)

Mon-2019-09-30 Tue-2019-10-01 Wed-2019-10-02 
             5              1              1 
Thu-2019-10-03 Fri-2019-10-04 Sat-2019-10-05 
             1              1              1 
Sun-2019-10-06 Mon-2019-10-07 Tue-2019-10-08 
             2              2              2 
Wed-2019-10-09 Thu-2019-10-10 Fri-2019-10-11 
             2              2              2 
Sat-2019-10-12 Sun-2019-10-13 
             2              3 

# Example tabled output:
library(tidyverse)

nth_week(some_dates) %>% 
  enframe('DATE','nth_week_default') %>% 
  cbind(some_year_day_options = as.vector(nth_week(some_dates, count_weeks_in = 'year', begin_week_on = 'mon')))

             DATE nth_week_default some_year_day_options
1  Mon-2019-09-30                5                    40
2  Tue-2019-10-01                1                    40
3  Wed-2019-10-02                1                    40
4  Thu-2019-10-03                1                    40
5  Fri-2019-10-04                1                    40
6  Sat-2019-10-05                1                    40
7  Sun-2019-10-06                2                    40
8  Mon-2019-10-07                2                    41
9  Tue-2019-10-08                2                    41
10 Wed-2019-10-09                2                    41
11 Thu-2019-10-10                2                    41
12 Fri-2019-10-11                2                    41
13 Sat-2019-10-12                2                    41
14 Sun-2019-10-13                3                    41

Надеюсь, эта работа сэкономит людям время.