#' Validate a Finnish personal identification number (HETU).
#'
#' @param hetu Finnish personal identification number as a string.
#'
#' @return Is the given string a valid Finnish personal identification number, TRUE or FALSE.
#'
#' @author Jussi Paananen \email{louhos@@googlegroups.com}
#'
#' @seealso \code{\link{hetu}} For extracting information from a Finnish personal identification number.
#'
#' @examples
#' valid_hetu("010101-0101") # TRUE
#' valid_hetu("010101-010A") # FALSE
#' @export
valid_hetu <- function(hetu) {
# Try to create hetu-object from the given hetu, check if created object is of class "hetu"
return(class(hetu(hetu)) == "hetu")
}
#' Extract information from a Finnish personal identification number
#'
#' @param hetu Finnish personal identification number as a string
#'
#' @return Finnish personal identification number object.
#' Returns NA if the given string is not a valid Finnish personal identification number.
#' \item{hetu}{Finnish personal identification number as a string.}
#' \item{gender}{Gender of the person. Male or Female.}
#' \item{personal.number}{Personal number part of the identification number.}
#' \item{checksum}{Checksum for the personal identification number.}
#' \item{date}{Birthdate.}
#' \item{day}{Day of the birthdate.}
#' \item{month}{Month of the birthdate.}
#' \item{year}{Year of the birthdate.}
#' \item{century.char}{Century of the birthdate: + (1800), - (1900) or A (2000). }
#'
#' @author Jussi Paananen \email{louhos@@googlegroups.com}
#'
#' @seealso \code{\link{valid_hetu}} For validating Finnish personal identification number.
#' @examples
#' hetu("111111-111C")
#' hetu("111111-111C")$date
#' hetu("111111-111C")$gender
#' @export
hetu <- function(hetu) {
# Check general format
match <- regexpr("^[0-9]{6}[\\+-A][0-9]{3}[0123456789ABCDEFHJKLMNPRSTUVWXY]$", hetu)
if (match == -1 ) {
return(NA)
}
# Check day
day <- as.numeric(substr(hetu, start=1, stop=2))
if (!((day >= 1) && (day <= 31))) {
return(NA)
}
# Check month
month <- as.numeric(substr(hetu, start=3, stop=4))
if (!((month >= 1) && (month <= 12))) {
return(NA)
}
# Check year
year <- as.numeric(substr(hetu, start=5, stop=6))
if (!((year >= 1) && (year <= 99))) {
return(NA)
}
# Check century
century <- substr(hetu, start=7, stop=7)
if (!century %in% c("+", "-", "A")) {
return(NA)
}
# Construct complete year from century character and 2-digit year
## Pad leading zero to a 2-digit year if needed
year <- formatC(year, flag=0, width=2)
if (century == "+") {
full.year <- as.numeric(paste("18", year, sep=""))
}
if (century == "-") {
full.year <- as.numeric(paste("19", year, sep=""))
}
if (century == "A") {
full.year <- as.numeric(paste("20", year, sep=""))
}
# Check if date exists
date <- as.Date(paste(day, "/", month, "/", full.year, sep=""), "%d/%m/%Y")
if (is.na(date)) {
return(NA)
}
# Check personal identification number
personal <- as.numeric(substr(hetu, start=8, stop=10))
if (!((personal >= 2) && (personal <= 899))) {
return(NA)
}
# Check checksum character validity
check <- substr(hetu, start=11, stop=11)
checklist <- c("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F", "H", "J", "K", "L", "M", "N", "P", "R", "S", "T", "U", "V", "W", "X", "Y")
names(checklist) <- 0:30
if (!check %in% checklist) {
return(NA)
}
# Check checksum character
mod <- as.numeric(paste(substr(hetu, start=1, stop=6), substr(hetu, start=8, stop=10), sep="")) %% 31
if (check != checklist[as.character(mod)]) {
return(NA)
}
# Check gender
if ((personal %% 2) == 0) {
gender <- "Female"
} else {
gender <- "Male"
}
# Create hetu-object
object <- list(hetu = hetu, gender=gender, personal.number=personal, checksum=check, date=date, day=day, month=month, year=full.year, century.char=century)
class(object) <- "hetu"
return (object)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.