R程序分享1：intnx

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

刚刚学习R，之前只会SAS
SAS里面有一个关于时间的函数，INTNX，作用是计算从开始日期经过指定个时间间隔后的日期
R里有类似的，但好像没有功能一样完善的，所以自己写了一个
写得比较麻烦，希望提出改进意见

1. # 本函数作用是计算从开始日期经过指定个时间间隔后的日期。
   
2. 
   
3. # DateStr是原始日期字符串变量；TimeInterval是时间间隔，=D、W、M、Q、H、Y分别表示时间间隔为日、周、月、季、半年、年，仅能设置一个；N是时间间隔的个数，负值表示向前查找；Align是标记变量，=Beginning、Sameday、End分别表示返回一个周期的开始日期、相同日期和结束日期。
   
4. 
   
5. # 最后返回的是从开始日期经过指定个时间间隔后的日期。
   
6. 
   
7. # Created on 2014.3.19
   
8. # Modified on 2014.3.19
   
9. 
   
10. intnx <- function(DateStr,TimeInterval,N,Align="sameday"){
    
11.   library(lubridate)
    
12.   
    
13.   stopifnot(is.character(DateStr)||is.Date(DateStr))
    
14.   stopifnot(is.numeric(N))
    
15.   
    
16.   # 检查TimeInterval的合法性
    
17.   if (length(grep("(D|W|M|Q|H|Y)",TimeInterval,ignore.case=TRUE)) == 0)
    
18.     stop("Error: The TimeInterval should be one of D, M, W, Q, H, and Y, case insensitive and with quotes.;")
    
19.   
    
20.   # 开始进行计算
    
21.   if (toupper(TimeInterval) == "D"){
    
22.     temp <- as.Date(DateStr) + N
    
23.   }
    
24.   else if (toupper(TimeInterval) == "W"){
    
25.     if (toupper(Align) == "SAMEDAY"){
    
26.       temp <- as.Date(DateStr) + N*7
    
27.     }
    
28.     else if (toupper(Align) == "BEGINNING"){
    
29.       temp <- as.Date(DateStr) + N*7
    
30.       temp <- temp-(wday(temp)-1)
    
31.     }
    
32.     else if (toupper(Align) == "END"){
    
33.       temp <- as.Date(DateStr) + N*7
    
34.       temp <- temp+(7-wday(temp))
    
35.     }
    
36.   }
    
37.   else if (toupper(TimeInterval) == "M"){
    
38.     if (toupper(Align) == "SAMEDAY"){
    
39.       temp <- as.Date(DateStr) %m+% months(N)
    
40.     }
    
41.     else if (toupper(Align) == "BEGINNING"){
    
42.       temp <- as.Date(paste(substr(as.Date(DateStr) %m+% months(N),1,8),"01",sep=""))
    
43.     }
    
44.     else if (toupper(Align) == "END"){
    
45.       temp <- as.Date(paste(substr(as.Date(DateStr) %m+% months(N+1),1,8),"01",sep=""))-1
    
46.     }
    
47.   }
    
48.   else if (toupper(TimeInterval) == "Q"){
    
49.     if (toupper(Align) == "SAMEDAY"){
    
50.       temp <- as.Date(DateStr) %m+% months(N*3)
    
51.     }
    
52.     else if (toupper(Align) == "BEGINNING"){
    
53.       temp <- as.Date(DateStr) %m+% months(N*3)
    
54.       temp <- as.Date(paste(substr(temp,1,4),(floor((month(temp)-1)/3))*3+1,"01",sep="-"))
    
55.     }
    
56.     else if (toupper(Align) == "END"){
    
57.       temp <- as.Date(DateStr) %m+% months(N*3)
    
58.       temp <- (as.Date(paste(substr(temp,1,4),(floor((month(temp)-1)/3)+1)*3,"01",sep="-")) %m+% months(1))-1
    
59.     }
    
60.   }
    
61.   else if (toupper(TimeInterval) == "H"){
    
62.     if (toupper(Align) == "SAMEDAY"){
    
63.       temp <- as.Date(DateStr) %m+% months(N*6)
    
64.     }
    
65.     else if (toupper(Align) == "BEGINNING"){
    
66.       temp <- as.Date(DateStr) %m+% months(N*6)
    
67.       temp <- as.Date(paste(substr(temp,1,4),(floor((month(temp)-1)/6))*6+1,"01",sep="-"))
    
68.     }
    
69.     else if (toupper(Align) == "END"){
    
70.       temp <- as.Date(DateStr) %m+% months(N*6)
    
71.       temp <- (as.Date(paste(substr(temp,1,4),(floor((month(temp)-1)/6)+1)*6,"01",sep="-")) %m+% months(1))-1
    
72.     }
    
73.   }
    
74.   else if (toupper(TimeInterval) == "Y"){
    
75.     if (toupper(Align) == "SAMEDAY"){
    
76.       temp <- as.Date(DateStr) %m+% years(N)
    
77.     }
    
78.     else if (toupper(Align) == "BEGINNING"){
    
79.       temp <- as.Date(DateStr) %m+% years(N)
    
80.       temp <- as.Date(paste(substr(temp,1,4),"01","01",sep="-"))
    
81.     }
    
82.     else if (toupper(Align) == "END"){
    
83.       temp <- as.Date(DateStr) %m+% years(N)
    
84.       temp <- as.Date(paste(substr(temp,1,4),"12","31",sep="-"))
    
85.     }
    
86.   }
    
87. 
    
88.   return(temp)
    
89. }
    
90. 
    
91. Demo <- function(){
    
92.   date <- intnx(DateStr="2014-7-4",TimeInterval="H",N=1,Align="beginning")
    
93. }

复制代码

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏0 回帖

关键词：int R程序 Beginning Modified Interval 程序

base包
lubridate包
scales包  
都有对应函数实现吧。。