version 0.0.4

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: epifit
 Type: Package
 Title: Flexible Modelling Functions for Epidemiological Data Analysis
-Version: 0.0.3
-Date: 2015-10-01
+Version: 0.0.4
+Date: 2015-11-01
 Author: Kazutaka Doi [aut,cre],
         Kei Sakabe [ctb],
         Masataka Taruri [ctb]
@@ -18,6 +18,6 @@ NeedsCompilation: yes
 ByteCompile: true
 Imports: stats, MASS
 Suggests: survival
-Packaged: 2015-10-01 05:17:08 UTC; kazutaka
+Packaged: 2015-11-02 00:18:26 UTC; kazutaka
 Repository: CRAN
-Date/Publication: 2015-10-01 13:18:48
+Date/Publication: 2015-11-02 11:31:54

MD5

@@ -1,17 +1,29 @@
-17e089ae61960affeed3cf70774d53c6 *DESCRIPTION
-844d6a49b62cabc6fd2f30cd09f77c9c *NAMESPACE
-fec108d04c0a0b85b6e06cd62ac0aacc *NEWS
-cf1dac4f20bce5aa8bd60f336637bf49 *R/AIC.epifit.R
-da7c1814ff539a578dbfcefacf000384 *R/epifit-package.R
-9ead0dd58721e9c9805931e02330101b *R/epifit.R
-7d9d4a1c0b9815b4499e8e152ef47141 *R/modules.R
-37ae334b0499226a589d257ef3f52c8d *R/print.epifit.R
-e34d0d507780fee1ef1dfbceb84ab8bb *R/pytable.R
-794302dcda40fab09aeefc1adbc7d0e9 *man/AIC.epifit.Rd
-401433cb87f447517b133bc5cbddb474 *man/epifit-package.Rd
-ccd78ca14885329dd6a6adbfacb3707b *man/epifit.Rd
-43c7fb88046f9a517b7f1198a54fdc06 *man/print.epifit.Rd
-3f553022602d8b5ceb73be02569b1e36 *man/pytable.Rd
+32288f3179fb0440d8bb05d7d96f2c31 *DESCRIPTION
+a699ed81a8e2db7f92bdc7e0ff0bb806 *NAMESPACE
+362daac24dba844ee72e3f1461bea920 *NEWS
+c731dbd4287f76ea58ae568b3d48d854 *R/AIC.epifit.R
+f32940a38c14fd83179553d8faadd087 *R/calcAge.R
+02ee08e34ba9280107c612a2a73e3952 *R/convertNA.R
+f9aa47f0b45af23b6eb222e3fc2209c9 *R/countNA.R
+2d44f2e4f9112198446298c4f9c9981d *R/epifit-package.R
+4234881f5192ff233644e3955d9e9e50 *R/epifit.R
+79f74128ec4c844a22e9ba765d8ac074 *R/extractVariable.R
+d10ee87a519163a91223e3c63d797964 *R/modules.R
+b132e15e4400b329842ec658d23dd409 *R/print.epifit.R
+f19bbdaf163a98894d1c2b8fa8e33d97 *R/pullOneValue.R
+a2ea075936dd35c3facb5e9403c96664 *R/pytable.R
+83ae3b79163122da2738af6d4cf59d88 *R/removeVariable.R
+93c35ed9744ac0a06725220f3426201a *man/AIC.epifit.Rd
+f5049795835ecd9e77bc77b18dc957d4 *man/calcAge.Rd
+6b48b0d2d2e53cba883f81842498721d *man/convertNA.Rd
+e25fdbe2bc9fdcd6fa3b753589530eec *man/countNA.Rd
+0ab2ced76107b8f00318fa90db3e1b39 *man/epifit-package.Rd
+389b6f92e3f6b9561030d92062429bc2 *man/epifit.Rd
+938d7770a1dcb6b47513dedd752fea37 *man/extractVariable.Rd
+766d530d0dee1c69fc3e4b1fd1702cb8 *man/print.epifit.Rd
+72b6190d3f8d5546a761198c6355dcec *man/pullOneValue.Rd
+6b8964041f63404dbbbbae1c346a59c6 *man/pytable.Rd
+1dc9b6b6d926511434d611a23abdcac1 *man/removeVariable.Rd
 e3d3cb360fbfdb3c6974e14eb5f09870 *src/Makevars
 7cdf814e4e9d585eefe5531871ee692e *src/select.cpp
-6312d67a2185d19e4e6a7d917658eeae *src/select.h
+1d57bc1890ad4a58e17a905098a65968 *src/select.h

NAMESPACE

@@ -2,8 +2,14 @@
 
 S3method(AIC,epifit)
 S3method(print,epifit)
+export(calcAge)
+export(convertNA)
+export(countNA)
 export(epifit)
+export(extractVariable)
+export(pullOneValue)
 export(pytable)
+export(removeVariable)
 importFrom(MASS,ginv)
 importFrom(stats,dbinom)
 importFrom(stats,dgamma)
@@ -21,3 +27,4 @@ importFrom(stats,optim)
 importFrom(stats,pchisq)
 importFrom(stats,pnorm)
 useDynLib(epifit)
+useDynLib(epifit,Rf_select)

NEWS

@@ -1,5 +1,15 @@
 NEWS for the epifit package
 
+---------------------------------------------------------------------
+epifit 0.0.4 (2015/11/01)
+
+* Added removeVariable function
+* Added extractVariable function
+* Added countNA function
+* Added calcAge function
+* Added pullOneValue function
+* Added convertNA function
+
 ---------------------------------------------------------------------
 epifit 0.0.3 (2015/10/01)
 

R/AIC.epifit.R

@@ -1,10 +1,10 @@
-##' Function for calculating Akaike's \sQuote{An Information Criterion} (AIC) from epifit object
+##' Function for calculating Akaike's \sQuote{An Information Criterion} (AIC) from epifit object.
 ##'
 ##' Function called from generic function AIC in \pkg{stats} when the argument is epifit object.
-##' @title Akaike's An Information Criterion
-##' @param object a fitted epifit object for which there exists a 
+##' @param object a fitted epifit object.
 ##' @param ... not used in this version, only for compatibility purpose with generic function \code{AIC} currently.
 ##' @param k numeric, the \emph{penalty} per parameter to be used; the default \code{k = 2} is the classical AIC.
+##' @return a numeric AIC value.
 ##' @seealso \code{\link[stats]{AIC}}
 ##' @examples
 ##' library(survival)

R/calcAge.R

@@ -0,0 +1,20 @@
+##' Calculate the difference between two date in terms of unit of time.
+##'
+##' This function calculate the difference between two date in terms of unit of time, and age can be obtained when \sQuote{year} is specified as unit argument.
+##' @param birthday a character or character vector specifying birthday or base date.
+##' @param targetdate a character specifying current or target date.
+##' @param unit a character specifying unit for calculating the difference between the two dates. Values of "year", "month" and "day" are supported.
+##' @return a vector of age
+##' @examples calcAge("1963-2-3")
+##' @examples calcAge("1970-1-1", unit="day")
+##' @export
+calcAge <- function(birthday, targetdate=Sys.Date(), unit="year"){
+  sapply(birthday,
+         function(x){
+           tryCatch(
+             {length(seq(as.Date(x), as.Date(targetdate), unit)) - 1},
+             error=function(e){NA})
+         },
+         USE.NAMES=FALSE
+         )
+}

R/convertNA.R

@@ -0,0 +1,40 @@
+##' Convert a character pattern into NA in character and vice versa.
+##'
+##' Convert a character pattern into NA in character and vice versa.
+##' @param data a data.frame to summarize.
+##' @param na.character a character vector specifying missing character.
+##' @param reverse a logical value specifying reverse replacement that NA is replaced with the first element of na.character.
+##' @return a data.frame with NA replacement.
+##' @seealso
+##' \code{\link{countNA}}
+##' @examples
+##' dat <- data.frame(a=c("","2","3"),b=c("4", NA, "."), stringsAsFactors=FALSE)
+##' dat2 <- convertNA(dat)
+##' dat3 <- convertNA(dat2, na.character=".", reverse=TRUE)
+##' dat
+##' dat2
+##' dat3
+##' @export
+convertNA <- function(data=NULL, na.character=c("", "."), reverse=FALSE){
+
+  if (is.null(data) || !is.data.frame(data)) 
+    stop("data is not specified or not data.frame")
+
+  n <- nrow(data)
+
+  for(i in 1:ncol(data)){
+    if(!is.character(data[,i]))
+      next
+    for(j in 1:n){
+      if(reverse){
+        if(is.na(data[j,i]))
+           data[j,i] <- na.character[1]
+         } else {
+        if(data[j,i] %in% na.character)
+          data[j,i] <- NA
+      }
+    }
+  }
+
+  return(data)
+}

R/countNA.R

@@ -0,0 +1,30 @@
+##' Count NA in variables.
+##'
+##' Count NA, and calculate NA proportion in data.frame.
+##' @param data a data.frame to summarize.
+##' @return a matrix with total data, NA count and NA proportion.
+##' @seealso
+##' \code{\link{convertNA}}
+##' @examples
+##' df <- data.frame(id=1:1000, cov1=rnorm(1000), cov2=runif(1000))
+##' df$cov1 <- ifelse(df$cov1 < 0, NA, df$cov1)
+##' df$cov2 <- ifelse(df$cov2 < 0.2, NA, df$cov2)
+##' countNA(df)
+##' @export
+countNA <- function(data=NULL){
+
+  if (is.null(data) || !is.data.frame(data)) 
+    stop("data is not specified or not data.frame")
+
+  n <- nrow(data)
+  result <- matrix(n, ncol(data), 3)
+  rownames(result) <- colnames(data)
+  colnames(result) <- c("missing", "total", "percent(%)")
+
+  for(i in 1:ncol(data)){
+    result[i,1] <- sum(as.integer(is.na(data[,i])))
+    result[i,3] <- result[i,1]/result[i,2]*100
+  }
+
+  return(result)
+}

R/epifit-package.R

@@ -1,4 +1,4 @@
-#' Flexible Modelling Functions for Epidemiological Data Analysis
+#' Flexible Modelling Functions for Epidemiological Data Analysis.
 #'
 #' Provides flexible model fitting used in epidemiological data analysis
 #' by a unified model specification, along with some data manipulation functions.
@@ -14,8 +14,14 @@
 #' Author: Kazutaka Doi, Kei Sakabe and Masataka Taguri
 #' Maintainer: Kazutaka Doi \email{kztkdi@@gmail.com}
 #' @seealso
+#' \code{\link{calcAge}},
+#' \code{\link{convertNA}},
+#' \code{\link{countNA}},
 #' \code{\link{epifit}},
-#' \code{\link{pytable}}
+#' \code{\link{extractVariable}},
+#' \code{\link{pullOneValue}},
+#' \code{\link{pytable}},
+#' \code{\link{removeVariable}}
 #' @useDynLib epifit
 #' @importFrom stats dbinom dgamma dnbinom dnorm dpois dweibull integrate na.exclude na.fail na.omit na.pass nlm optim pchisq pnorm
 #' @importFrom MASS ginv

R/epifit.R

@@ -25,8 +25,12 @@
 #' @param verbatim a integer value from 0 (minimum) to 2 (maximum) controlling the amount of information printed during calculation.
 #' @param ... for the arguments used in the inner functions (currently not used).
 #' @return a list containing the result of model fitting including parameter estimates, variance of parameter estimates, log likelihood and so on.
+#' @useDynLib epifit Rf_select
 #' @references DeLong, D. M., Guirguis, G.H., and So, Y.C. (1994). Efficient computation of subset selection probabilities with application to Cox regression. \emph{Biometrika} \strong{81}, 607-611.
 #' @references Gail, M. H., Lubin, J. H., and Rubinstein, L. V. (1981). Likelihood calculations for matched case-control studies and survival studies with tied death times. \emph{Biometrika} \strong{68}, 703-707.
+#' @seealso
+#' \code{\link{AIC.epifit}},
+#' \code{\link{print.epifit}}
 #' @examples
 #' library(survival)
 #' 

R/extractVariable.R

@@ -0,0 +1,34 @@
+##' Extract variables according to mode from data.frame.
+##'
+##' This function extract variables which match specified mode from data.frame, and make a new data frame.
+##' @param data a data.frame from which numeric variables are extracted.
+##' @param mode a character specifying object type. Object modes of \sQuote{numeric}, \sQuote{character}, \sQuote{factor}, and \sQuote{logical} are supported.
+##' @return a data.frame which includes only specified mode of variables.
+##' @examples
+##' df <- data.frame(id=seq(1,10), str=letters[1:10], fac=factor(seq(1,10)), stringsAsFactors=FALSE)
+##' extractVariable(df)
+##' extractVariable(df, mode="character")
+##' extractVariable(df, mode="factor")
+##' @export
+extractVariable <- function(data=NULL, mode="numeric"){
+
+  if(is.null(data)||!is.data.frame(data))
+    stop("data is not specified or not data.frame")
+
+  idx <- rep(TRUE, ncol(data))
+
+  funcname <- paste("is.", mode, sep="")
+  if(exists(funcname, mode="function", envir=.BaseNamespaceEnv)){
+    func <- get(funcname, mode="function", envir=.BaseNamespaceEnv)
+  } else {
+    stop("Invalid mode")
+  }
+
+  for(i in 1:ncol(data)){
+    if(!func(data[,i])){
+      idx[i] = FALSE
+    }
+  }
+
+  return(data[,idx,drop=FALSE])
+}

R/modules.R

@@ -133,7 +133,7 @@ SolveDependence <- function(vec_depvar, lst_eqnassigned, lst_eqndepend, vec_eqns
           unsolved <- unsolved[unsolved != lst_eqndepend[[i]]]
           resfml <- c(SolveDependence(lst_eqndepend[[i]], lst_eqnassigned, lst_eqndepend, vec_eqns), resfml)
         } else if(length(lst_eqndepend[[i]]) > 1){
-          unsolved <- RemoveVariable(unsolved, lst_eqndepend[[i]])
+          unsolved <- RemoveVariableName(unsolved, lst_eqndepend[[i]])
           resfml <- c(SolveDependence(lst_eqndepend[[i]], lst_eqnassigned, lst_eqndepend, vec_eqns), resfml)
         }
         break
@@ -192,7 +192,7 @@ InnerInsertFormula <- function(psd_target, chr_var, psd_fml){
 }
 
 ## remove some variable names from variable list
-RemoveVariable <- function(varlist, remove){
+RemoveVariableName <- function(varlist, remove){
   flag <- rep(TRUE, length(varlist))
   for(i in 1:length(remove)){
     for(j in 1:length(varlist)){
@@ -301,7 +301,7 @@ GetParamPosition <- function(param, paramlist){
       if(x == paramlist[i])
         return(i)
     }
-  })
+  }, USE.NAMES=FALSE)
 }
 
 ## Make epifit result object from optim function
@@ -538,7 +538,7 @@ LogCoxLikelihood <- function(init, parameters, equations, itereq, envs, time1nam
           } else if(ties=="discrete"){
 
             if(tieevent > 0){
-              phazard[tiebegin] <- prod(phazard[tiebegin:(tiebegin+tieevent-1)])/.Call("Rf_select", tieevent, nsubject-tiebegin+1, phazard[tiebegin:nsubject])
+              phazard[tiebegin] <- prod(phazard[tiebegin:(tiebegin+tieevent-1)])/.Call(Rf_select, tieevent, nsubject-tiebegin+1, phazard[tiebegin:nsubject])
               status[tiebegin] <- 1 # regard as event
               riskset[tiebegin] <- 1
               status[(tiebegin+1):(i-1)] <- 0

R/print.epifit.R

@@ -1,7 +1,7 @@
-##' Print function for epifit object
+##' Print function for epifit object.
 ##'
 ##' This function print result of function \code{\link{epifit}}
-##' 
+##'
 ##' @param x Object of class \code{epifit}.
 ##' @param digits a non-null value for digits specifies the minimum number of significant digits to be printed in values. The default,  uses \code{max(\link[base:options]{getOption}}(digits - 4, 3)).
 ##' @param ... Further arguments passed to or from other methods.