Основной календарь отображения в R - PullRequest
9 голосов
/ 27 октября 2011

Есть ли в R базовое отображение календаря, как в cal программе Unix?

Я понимаю, что не так сложно обернуть базовые функции даты / времени (например, weekdays, seq.date и т. Д.), Но я чувствую, что не знаю чего-то довольно простого, что может быть решено в одной из выдающиеся пакеты времени / даты, которые уже существуют. Более того, он всегда начинается достаточно просто: назначайте дни недели, но потом можно висеть на високосных годах, макет для календарей, охватывающих несколько месяцев (хотя я бы предпочел просто печатать 1 месяц), и так далее.

Мое текущее использование включает в себя переключение с R на Linux или программу-календарь в Windows. Делать это в R. было бы легче.


Примечание 1. Я рассмотрел некоторые из различных виджетов, доступных для Gtk2 и TclTk - по какой-то причине установка вспомогательных систем не работает должным образом (и я думаю, что это серьезное излишество, а также не очень хорошее с точки зрения Перспективность переносимости, чтобы иметь такие зависимости). В Windows я даже пробовал Cygwin для доступа к cal, но эта установка, похоже, конфликтует с Rtools. Короче говоря, в настоящее время добавление слоев не является особенно продуктивным способом. :) Я не нашел никаких решений в lubridate, xts, zoo и других пакетах, хотя я мог что-то пропустить.

1 Ответ

12 голосов
/ 28 октября 2011

Вот функция, которая будет выполнять основной годовой или месячный календарь:

cal <- function(month, year) {

        if(!require(chron)) stop('Unable to load chron package')

     if(missing(year) && missing(month)) {
         tmp <- month.day.year(Sys.Date())
         year <- tmp$year
         month <- tmp$month
     }


    if(missing(year) || missing(month)){  # year calendar
        if(missing(year)) year <- month
        par(mfrow=c(4,3))
        tmp <- seq.dates( from=julian(1,1,year), to=julian(12,31,year) )
        tmp2 <- month.day.year(tmp)
        wd <- do.call(day.of.week, tmp2)
        par(mar=c(1.5,1.5,2.5,1.5))
        for(i in 1:12){
            w <- tmp2$month == i
            cs <- cumsum(wd[w]==0)
            if(cs[1] > 0) cs <- cs - 1
            nr <- max( cs ) + 1
            plot.new()
            plot.window( xlim=c(0,6), ylim=c(0,nr+1) )
            text( wd[w], nr - cs -0.5 , tmp2$day[w] )
            title( main=month.name[i] )
            text( 0:6, nr+0.5, c('S','M','T','W','T','F','S') )
        }

    } else {  # month calendar

        ld <- seq.dates( from=julian(month,1,year), length=2, by='months')[2]-1
        days <- seq.dates( from=julian(month,1,year), to=ld)
        tmp <- month.day.year(days)
        wd <- do.call(day.of.week, tmp)
        cs <- cumsum(wd == 0)
        if(cs[1] > 0) cs <- cs - 1
        nr <- max(cs) + 1
        par(oma=c(0.1,0.1,4.6,0.1))
        par(mfrow=c(nr,7))
        par(mar=c(0,0,0,0))
        for(i in seq_len(wd[1])){ 
            plot.new()
            #box()
        }
        day.name <- c('Sun','Mon','Tues','Wed','Thur','Fri','Sat')
        for(i in tmp$day){
            plot.new()
            box()
            text(0,1, i, adj=c(0,1))
            if(i < 8) mtext( day.name[wd[i]+1], line=0.5,
                at=grconvertX(0.5,to='ndc'), outer=TRUE ) 
        }
        mtext(month.name[month], line=2.5, at=0.5, cex=1.75, outer=TRUE)
        #box('inner') #optional 
    }
}

Вы можете редактировать различные части, чтобы настроить его. Вы можете использовать par(mfg=c(r,c)) для добавления текста, графиков или другой информации в указанную ячейку в месячном календаре (см. updateusr и subplot в пакете TeachingDemos для возможной помощи в добавлении графика).

Вот несколько примеров добавления текста или графиков в календарь:

cal(10,2011)
par(mfg=c(3,2))  # monday oct 10
text(.5,.5, 'Some\nText', cex=2)

par(mfg=c(2,3)) #Tues oct 4
text(1,1, 'Top Right', adj=c(1,1))

par(mfg=c(2,4)) # Wed oct 5
text(0,0, 'Bottom Left', adj=c(0,0))

par(mfg=c(6,2)) # oct 31
tmp.x <- runif(25)
tmp.y <- rnorm(25,tmp.x,.1)
par(usr=c( range(tmp.x), range(tmp.y) ) )
points(tmp.x,tmp.y)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...