R/ZZZ.R

Defines functions .onAttach

.onAttach <- function(...){
    cnOS <- do::cnOS()
    (temp <- config_temp())
    (ck_years <- suppressMessages(get_config_years()))
    (ck_items <- suppressMessages(get_config_items()))
    (ck_path <- suppressMessages(get_config_path()))
    (ck <- any(is.null(ck_years),is.null(ck_items),is.null(ck_path)))
    nhanes_check <- getOption('nhanesR_check')
    if (is.null(nhanes_check)) nhanes_check <- TRUE
    if (ck){
        if (cnOS) packageStartupMessage(tmcn::toUTF8("\u5728\u4F7F\u7528nhanesR\u5305\u4E4B\u524D,\u8BF7\u5148\u5B8C\u6210\u4EE5\u4E0B3\u9879\u914D\u7F6E\n     1.\u4F7F\u7528config_path()\u547D\u4EE4\u914D\u7F6E\u6570\u636E\u5E93\u8DEF\u5F84\n     2.\u4F7F\u7528config_years()\u547D\u4EE4\u914D\u7F6E\u6570\u636E\u5E93\u5E74\u4EFD\n     3.\u4F7F\u7528config_items()\u547D\u4EE4\u914D\u7F6E\u6570\u636E\u5E93\u6587\u4EF6\u7C7B\u578B"))
        if (!cnOS) packageStartupMessage('Before using the nhanesR package\nplease complete the following 3 configurations\n     1. Use config_path() command to configure the PC database path\n     2. use config_years() command to configure the database year\n     3. use config_items() command to configure the database items')
    }else if (nhanes_check){
        # check years every 15 days
        (day15 <- paste0(temp,'/day15.checkyears'))
        (ck <- file.exists(day15))
        if (ck){
            diff <- as.numeric(Sys.Date() - as.Date(rev(read.table(day15,header = FALSE)[,1])[1]))
            if (diff >= 15) ck <- FALSE
        }
        # if no day15 and diff is over 15: check years
        if (!ck){
            if (cnOS) (checkyears <- tmcn::toUTF8("\u68C0\u67E5\u914D\u7F6E\u5E74\u4EFD\u548C\u7F51\u7AD9\u5E74\u4EFD\u662F\u5426\u4E00\u81F4"))
            if (!cnOS) (checkyears <- 'Check that the year of configuration and website')
            packageStartupMessage(checkyears)
            # local years
            x <- get_config_years() |> do::increase()
            head <- rep(c('Config: ','',''),length(x) %/% 3+1)[1:length(x)]
            head[1] <- paste0('\n',head[1])
            head[2:length(head)] <- do::Replace(head[2:length(head)],'Config: ','        ')
            tail <- rep(c(', ',', ','\n'),length(x) %/% 3+1)[1:length(x)]
            if (tail[length(tail)]==', ') tail[length(tail)]=''
            y <- paste0(head,x,tail)
            packageStartupMessage(y)

            # website years
            wby <- tryCatch(nhs_years_web(),error=function(e) 'e')
            if (all(wby == 'e')){
                if (cnOS) tmcn::toUTF8("\u83B7\u53D6\u7F51\u9875\u6570\u636E\u5931\u8D25") |> packageStartupMessage()
                if (!cnOS) 'Failed to get web data' |> packageStartupMessage()
            }else{
                wby <- do::increase(wby)
                head <- rep(c('Website:','',''),length(wby) %/% 3+1)[1:length(wby)]
                head[1] <- paste0('\n',head[1])
                head[2:length(head)] <- do::Replace(head[2:length(head)],'Website:','        ')
                tail <- rep(c(', ',', ','\n'),length(wby) %/% 3+1)[1:length(wby)]
                if (tail[length(tail)]==', ') tail[length(tail)]=''
                y <- paste0(head,wby,tail)
                packageStartupMessage(y)

                # compare website and local
                if (all(x == wby)){
                    # the same
                    if (cnOS) tmcn::toUTF8("\n\u914D\u7F6E\u5E74\u4EFD\u548C\u7F51\u7AD9\u5E74\u4EFD\u76F8\u540C") |> packageStartupMessage()
                    if (!cnOS) '\nThe same year of configuration and website' |> packageStartupMessage()
                }else{
                    if (length(set::not(wby,x))>1){
                        newyear <- set::not(wby,x)
                        # add new year
                        if (cnOS) tmcn::toUTF8('\u52A0\u4E86\u65B0\u5E74: ') |> packageStartupMessage(paste0(newyear,collapse = ', '))
                        if (!cnOS) 'add new year: ' |> packageStartupMessage(paste0(newyear,collapse = ', '))
                        # config
                        if (cnOS) tmcn::toUTF8('\u8BF7\u4F7F\u7528nhs_config_years()\u547D\u4EE4\u91CD\u65B0\u914D\u7F6E\u5E74\u4EFD') |> packageStartupMessage()
                        if (!cnOS) 'Use the nhs_config_years() command to re-configure Years' |> packageStartupMessage()
                        # update please
                        if (cnOS) tmcn::toUTF8('\u8BF7\u4F7F\u7528nhs_update()\u547D\u4EE4\u66F4\u65B0\u6570\u636E\u5E93') |> packageStartupMessage()
                        if (!cnOS) 'Use the nhs_update() command to update the database' |> packageStartupMessage()
                    }
                }
            }
        }
        # path
        if (cnOS) paste0(tmcn::toUTF8("\n\u6570\u636E\u5E93\u8DEF\u5F84\u662F: "),get_config_path()) |> packageStartupMessage()
        if (!cnOS) paste0('The database path is: ',get_config_path()) |> packageStartupMessage()

        # update
        updatetxt <- paste0(get_config_path(),'/update.txt')
        if (file.exists(updatetxt)){
            last <- readLines(updatetxt)
            diff <- as.numeric(Sys.Date()-as.Date(last))
            if (cnOS) tmcn::toUTF8("\n\u672B\u6B21\u66F4\u65B0\u65E5\u671F\u662F: ") |> packageStartupMessage(last)
            if (!cnOS) '\nThe lastest update date: ' |> packageStartupMessage(last)
            if (diff>15){
                if (cnOS) tmcn::toUTF8("\u672A\u66F4\u65B0\u5929\u6570: ") |> packageStartupMessage(diff)
                if (!cnOS) 'Number of days without update: ' |> packageStartupMessage(diff)
            }
        }else{
            if (cnOS) tmcn::toUTF8("\n\u672A\u66FE\u4F7F\u7528nhs_update()\u51FD\u6570\u8FDB\u884C\u66F4\u65B0") |> packageStartupMessage()
            if (!cnOS) '\nNo update has been made using the nhs_update() function' |> packageStartupMessage()
        }
        write.table(as.character(Sys.Date()),day15,append = TRUE,col.names = FALSE,row.names = FALSE)
    }
}
yikeshu0611/nhanesR documentation built on Jan. 29, 2022, 6:08 a.m.