3

日付のベクトルを入力として取り、日付のベクトルを返す関数を作成しようとしています。出力は、入力日に一致する月の最初の火曜日の日付です。

だから2012-11-19-->2012-11-06など。

私は単一の日付である程度の成功を収めましたが、ベクトルの場合に一般化することはできませんでした. 誰か助けてくれませんか？

これは私がこれまでに持っているものです:

firstTuesday <- function(tt){
  ct <- as.POSIXct(tt)
  lt <- as.POSIXlt(tt)
  firstOf <- as.POSIXlt(ct - 60*60*24* (lt$mday - 1))
  if (firstOf$wday > 2) 
  {
    adjDays <- (9 - firstOf$wday)
    firstTues <- as.POSIXlt(as.POSIXct(firstOf) + 60*60*24*adjDays)
  }
  else {
    adjDays  <- (2 - firstOf$wday)
    firstTues <- as.POSIXlt(as.POSIXct(firstOf) + 60*60*24*adjDays)
  }
  return(firstTues)
}

これは単一の日付に対して機能しますfirstTuesday(Sys.Date())が、日付のベクトルに対してジャンクを生成しました（ベクトル化ifされた制御演算子ではないという問題のためだと思います）。

索引付けを使用して、限られた理解を回避しました。次のコードはそのトリックを行うようです。

firstTuesday <- function(tt){
  ct <- as.POSIXct(tt)
  lt <- as.POSIXlt(tt)
  firstOf <- as.POSIXlt(ct - 60*60*24* (lt$mday - 1))
  firstTue <- as.POSIXct(firstOf)
  idx <- firstOf$wday > 2
  firstTue[idx]  <- as.POSIXct(firstOf[idx]) + 60*60*24*(9 - firstOf$wday[idx])
  firstTue[!idx]  <- as.POSIXct(firstOf[!idx]) + 60*60*24*(2 - firstOf$wday[!idx])
  return(firstTue)
}
4

2 に答える 2

3

基本関数を使用した簡単なソリューションを次に示します。

firstDayOfMonth <- function(dates, day="Mon", abbreviate=TRUE) {
  # first 7 days of month
  s <- lapply(as.Date(format(dates,"%Y-%m-01")), seq, by="day", length.out=7)
  # first day of month
  d <- lapply(s, function(d) d[weekdays(d,abbreviate)==day])
  # unlist converts to atomic, so use do.call(c,...) instead
  do.call(c, d)
}

まあ、do.call最後はそう簡単ではないかもしれませんが…でも、役に立つ知識です。:)

R> d <- as.Date(c("2012-11-19","2012-11-19","2011-01-15"))
R> firstDayOfMonth(d, "Tuesday", FALSE)
[1] "2012-11-06" "2012-11-06" "2011-01-04"
于 2012-11-19T13:48:03.850 に答える
3

これは lubridate を使用し、ロジックを少し単純にします。日付のベクトルを指定すると、2 番目の関数は入力と同様に文字のベクトルを返します。ニーズに合わせて物事を変えることができます。

library(lubridate)

getTuesday = function(x) {
    date = ymd(x)
    first = floor_date(date,"month")
    dow = sapply(seq(0,6),function(x) wday(first+days(x)))
    firstTuesday = first + days(which(dow==3)-1)
    return(firstTuesday)
}

getMultipleTuesdays = function(y) {
    tmp = lapply(y, getTuesday)
    tmp = lapply(tmp, as.character)
    return(unlist(tmp))
}

編集

サンプル入出力

getMultipleTuesdays(c("2012-11-19","2012-11-19","2011-01-15"))
[1] "2012-11-06" "2012-11-06" "2011-01-04"
于 2012-11-19T08:07:01.880 に答える