Additional note. I was not the only one who did this calculation. This weekend he mentioned some other listeners who emailed equivalent results to him.
Code
# days contains all days as month-day in a year.days <- format(as.Date('1900-01-01',format='%Y-%m-%d')+0:364,'%m-%d')
tail(days)
[1] "12-26" "12-27" "12-28" "12-29" "12-30" "12-31"
# does a year day combination fall in weekend,
# format makes Sunday to '0', Saturday to '6'
isspecday <- function(y,d) {
i <- paste(y,d,sep='-')
format(as.Date(i,format='%Y-%m-%d'),'%w') %in% c('0','6')
}
# which years have a weekend, for a given day (month day combination)
sourcedata <- function(dayno) {
year <- 1900:2100
days <- isspecday(year,days[dayno])
data.frame(year=year,sunday=days)
}
# example - use fifth day
sd1 <- sourcedata(5)
# reorganize in matrix so 20 , 30.. years after get next to each other
sd2 <- sapply(seq(20,80,10),function(x) sd1$sunday[(1:100)+x])
# make columns to ages
# other years get 1000, so min() can extract minimum age
sd3 <- sd2 * rep(1,100) %o% seq(20,80,10)
sd3[sd3==0] <- 1000
tail(sd3)
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[95,] 20 1000 1000 1000 1000 70 1000
[96,] 1000 30 1000 1000 1000 1000 80
[97,] 1000 1000 40 1000 1000 1000 80
[98,] 1000 1000 1000 50 1000 1000 1000
[99,] 1000 1000 1000 50 60 1000 1000
[100,] 20 1000 1000 1000 60 70 1000
# result, ages
table(apply(sd3,1,min))
20 30 40 50 60
28 22 21 22 7
# make a wrapper, i to become day
goodyear <- function(i) {
sd1 <- sourcedata(i)
sd2 <- sapply(seq(20,80,10),function(x) sd1$sunday[(1:100)+x])
sd3 <- sd2 * rep(1,100) %o% seq(20,80,10)
sd3[sd3==0] <- 1000
table(apply(sd3,1,min))
}
# and apply
sa <- sapply(1:365,goodyear)
# for brievety, only show last days
tail(t(sa))
20 30 40 50 60
[360,] 28 22 22 21 7
[361,] 28 22 21 22 7
[362,] 28 21 22 21 8
[363,] 29 21 21 22 7
[364,] 29 21 21 22 7
[365,] 29 22 21 21 7
# overall
colSums(t(sa))/365
20 30 40 50 60
28.572603 21.430137 21.424658 21.430137 7.142466
No comments:
Post a Comment