R:如何获得本月的周数

Nan*_*ndu 14 r date

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

通过使用以下代码:

>CurrentDate<-Sys.Date()
>Week Number <- format(CurrentDate, format="%U")
>Week Number
"31"
Run Code Online (Sandbox Code Playgroud)

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

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

我怎么能得到这个?

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

Ric*_*ven 10

您可以使用daylubridate包.我不确定包中是否有一个星期的类型函数,但我们可以算一算.

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
Run Code Online (Sandbox Code Playgroud)

  • 不要使用此方法。它不起作用,因为它没有考虑每月第一天的工作日。例如,2017年9月1日是星期五。使用9月4日星期一的此方法,我们得到的“ ceiling(day(ymd(“ 20170904”))/ 7)”等于“ 1”,但它应该是该月的第二周。 (2认同)

Art*_*sov 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
Run Code Online (Sandbox Code Playgroud)

stri_datetime_fields()stringi包中使用的另一种解决方案:

stringi::stri_datetime_fields(dates)$WeekOfMonth
#> [1] 4 4 2 4 2 3 3
Run Code Online (Sandbox Code Playgroud)


Tor*_*lad 8

问题概述

很难判断哪些答案有效,因此我构建了自己的函数nth_week并针对其他函数进行了测试。

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

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

例如,2019 年 10 月 1 日是星期二,因此进入 10 月的 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
Run Code Online (Sandbox Code Playgroud)

您可以看到只有Grothendieck、conighion、Freitas 和 Tori是正确的,因为他们处理了部分周期间。我比较了从 100 年到 3000 年的所有日子;这 4 个之间没有区别。(Stringi 可能正确地将周末记为单独的、递增的时期,但我没有检查确定;epiweek() 和 isoweek(),由于它们的预期用途,显示出一些奇怪的行为使用它们进行周增量时接近年末。)

速度比较

以下是以下实现之间的效率测试:Tori、Grothendieck、ConighionFreitas

# 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')

Run Code Online (Sandbox Code Playgroud)
# 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
Run Code Online (Sandbox Code Playgroud)
# 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
Run Code Online (Sandbox Code Playgroud)
# 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
Run Code Online (Sandbox Code Playgroud)
# 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
Run Code Online (Sandbox Code Playgroud)



最快正确算法至少提高 5 倍

需要(润滑)

(5 + 天(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')
Run Code Online (Sandbox Code Playgroud)



功能实现

我还为它编写了一个通用函数,它执行月或年的周计数,从你选择的一天开始(即你想在星期一开始你的一周),标签输出以便于检查,并且由于 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

}
Run Code Online (Sandbox Code Playgroud)



功能输出

# 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 
Run Code Online (Sandbox Code Playgroud)
# 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
Run Code Online (Sandbox Code Playgroud)

希望这项工作可以节省人们必须清除所有响应以找出正确答案的时间。


小智 6

我不知道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
Run Code Online (Sandbox Code Playgroud)

  • 这可以用R写成:`d < - as.Date("2014-09-18"); wk < - function(x)as.numeric(format(x,"%U")); wk(d) - wk(as.Date(cut(d,"month")))+ 1` (6认同)

Wil*_*tas 5

lubridate你可以做

ceiling((day(date) + first_day_of_month_wday(date) - 1) / 7)
Run Code Online (Sandbox Code Playgroud)

该函数first_day_of_month_wday返回每月第一天的工作日。

first_day_of_month_wday <- function(dx) {
  day(dx) <- 1
  wday(dx)
}
Run Code Online (Sandbox Code Playgroud)

为了获得正确的星期数,必须进行此调整,否则,例如,如果您在星期一的某个月的第7天,您将得到1而不是2。这只是一个月中的一天。负1是必需的,因为当月份的第一天是星期日时,不需要进行调整,而其他工作日都遵循此规则。