R:如何获得本月的周数

时间:2014-08-08 09:12:08

标签: r date

我是R.的新人 我想要日期所属的月份的周数。

使用以下代码:

>CurrentDate<-Sys.Date()
>Week Number <- format(CurrentDate, format="%U")
>Week Number
"31"

%U将返回当年的周数 但我想要一个月的周数 如果日期是2014-08-01,那么我想得到1.(日期属于该月的第一周)。

例如:
2014-09-04 - &gt; 1(日期属于该月的第1周) 2014-09-10 - &gt; 2(日期属于该月的第2周)  等等...

我怎么能得到这个?

参考: http://astrostatistics.psu.edu/su07/R/html/base/html/strptime.html

10 个答案:

答案 0 :(得分:10)

您可以使用 lubridate 包中的day。我不确定包中是否有一个星期的类型函数,但我们可以进行数学计算。

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

答案 1 :(得分:9)

类比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

答案 2 :(得分:5)

我不知道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

答案 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是必要的,因为当月的第一天是星期日时,不需要调整,而其他工作日则遵循这个规则。

答案 4 :(得分:2)

我遇到了同样的问题,我使用mday包中的data.table解决了这个问题。此外,我意识到在使用ceiling()功能时,还需要考虑第五周&#39;情况。例如,一个月的第30天ceiling 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

耗时约。计算超过70万天的周数需要3秒钟。

然而,上面的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

在31个月内每个星期分别获得7天,8天,8天和8天。

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

答案 5 :(得分:1)

使用lubridate软件包有一种简单的方法:

isoweek()返回星期,就像在ISO 8601系统中一样,该系统使用重复出现的leap周。

epiweek()是美国CDC版本的流行病学周。它遵循与以下相同的规则 isoweek(),但从星期日开始。在世界其他地方,惯例是从星期一开始流行病学周,与isoweek()相同。

引用here

答案 6 :(得分:1)

我参加聚会很晚,也许没人会读这个答案...

无论如何,为什么不保持简单并像这样:

library(lubridate)

x <- ymd(20200311, 20200308)

week(x) - week(floor_date(x, unit = "months")) + 1

[1] 3 2

答案 7 :(得分:0)

我不知道任何内置函数,但是可以解决

N

答案 8 :(得分:0)

问题概述

很难确定哪个答案有效,因此我建立了自己的函数 nth_week ,并针对其他函数进行了测试。

导致大多数答案不正确的问题是:

  • 一个月的第一周通常是短周
  • 与该月的最后一周相同

例如,2019年10月1日是星期二,因此距十月的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和Tori 是正确的,因为他们只对部分星期进行了处理。我比较了从100年到3000年的所有日子。在这4个之间没有区别。(Stringi可能正确地注意到周末是单独的,递增的时间段,但是我没有确定; epiweek()和isoweek()由于它们的预期用途而显示出一些奇怪的行为在将它们用于周增量时接近年末。)

速度比较

以下是 Tori,Grothendieck,Conighion, Freitas

的实现之间的效率测试。
# prep
library(lubridate)
library(tictoc)

kepler<- ymd(15711227) # Kepler's birthday since it's a nice day and gives a long vector of dates
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倍

  

要求(润滑)

     

(5 + day(some_dates)+ wday(floor_date(some_dates,'month')))%/%7

# some_dates above is any vector of dates, like:
some_dates<- seq(ymd(20190101), today(), 'day')



功能实现

我还为此编写了一个通用函数,该函数执行月或年的周计数,从您选择的一天开始(例如,您想在星期一开始一周),标记输出以便于检查,并且仍然非常快感谢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

希望这项工作节省了人们去掉所有答案以找出正确答案的时间。

答案 9 :(得分:0)

只需这样做:

图书馆(润滑)

ds1$Week <- week(ds1$Sale_Date)

这是高性能!它立即适用于我的 1200 万行数据集。 在上面的例子中,ds1 是数据集,Sale_Date 是一个日期列(如“2015-11-23”) 另一种方法,使用 "as.integer( format..." 可能适用于小型数据集,但在 1200 万行上它会永远运行......