##
## 1. an example
##
(xDate <- as.Date('1970-01-01')+c(0, 365))
(xPOSIX <- as.POSIXct(xDate)+c(1, 99))
xMSdate <- as.Date(1,
as.Date('1899-12-31'))+1:2
(fakeF1 <- data.frame(yr=c('1948',
'1947 (1)'),
q1=c(' 1,234 ', ''), duh=rep(NA, 2),
dol=c('$1,234', ''),
pct=c('1%', '2%'),
xDate=as.character(xDate,
format='%Y-%m-%d'),
xPOSIX=as.character(xPOSIX,
format='%Y-%m-%d %H:%M:%S'),
xMSdate=2:3, junk=c('this is',
'junk')))
# This converts the last 3 columns to NAs and drops them:
str(nF1.1 <- asNumericChar(fakeF1$yr))
str(nF1.2 <- asNumericChar(fakeF1$q1))
str(nF1.3 <- asNumericChar(fakeF1$duh))
(nF1.4 <- asNumericChar('1969-12-31 18:00:01',
class.='POSIXct'))
(nF1 <- asNumericDF(fakeF1))
(nF2 <- asNumericDF(fakeF1, Dates=6,
MSdate='xMSdate',
ignore=c('junk', 'xPOSIX'),
format.='%Y-%m-%d'))
# check
nF1. <- data.frame(yr=
asNumericChar(fakeF1$yr),
q1=asNumericChar(fakeF1$q1),
dol=asNumericChar(fakeF1$dol),
pct=c(.01, .02), xMSdate=2:3)
nF1c <- data.frame(yr=1948:1947,
q1=c(1234, NA), dol=c(1234, NA),
pct=c(.01, .02), xMSdate=2:3)
stopifnot(
all.equal(nF1, nF1.)
)
stopifnot(
all.equal(nF1., nF1c)
)
##
## 2. as.Date default example
##
xD <- asNumericChar(
as.character(xDate), class.='Date')
stopifnot(
all.equal(xDate, xD)
)
##
## 3. as.POSIXct default example
##
xPOSIX
(xPOSIXch <- as.character(xPOSIX))
(xP <- asNumericChar(xPOSIXch, class.='POSIXct'))
attr(xPOSIX, 'tzone')
attr(xP, 'tzone')
# R-Devel after 4.2.1 breaks earlier code; fix
if(is.null(attr(xPOSIX, 'tzone')))
attr(xPOSIX, 'tzone') <- attr(xP, 'tzone')
(dP <- difftime(xPOSIX, xP, units='secs'))
(madP <- max(abs(as.numeric(dP))))
stopifnot(
{
#all.equal(xPOSIX, xP)
# As of 2022-10-06 I don't know how to write code
# that will get a consistent answer with
# different version R-devel with differences
# less than an hour
if(madP>3600){
stop('Discrepancy betw fn and manual comp ',
'too large.')
}
TRUE
}
)
##
## 4. orderBy=1:2
##
nF. <- asNumericDF(fakeF1, orderBy=1:2)
stopifnot(
all.equal(nF., nF1c[2:1,])
)
##
## 5. Will it work for a tibble?
##
if(require(tibble)){
nF1t <- asNumericDF(as_tibble(fakeF1))
stopifnot(
all.equal(nF1, nF1t)
)
}
Run the code above in your browser using DataLab