Nothing
#' Guess Italian Fiscal Code
#'
#' The function tries to guess regular fiscal code, extracting relevant
#' alphanumeric digits from surname, name, birth date, gender and 'codice
#' catastale' (computing the last character, the control digit).
#'
#' @param surname character, surname
#' @param name character, names
#' @param birth_date Date, date of birth
#' @param female logical, female indicator variable (\code{FALSE} = man,
#' \code{TRUE} = woman)
#' @param codice_catastale Italian 'codice catastale' (an identifier) of
#' the 'comune' of birth
#' @return The function return a character vector of fiscal code.
#' @examples
#'
#' ## using fictious data
#' Surnames <- c("Rossi", "Bianchi")
#' Names <- c("Mario", "Giovanna")
#' Birthdates <- as.Date(c("1960-01-01", "1970-01-01"))
#' Female <- c(FALSE, TRUE)
#' Comune_of_birth <- c("F205", # milan
#' "H501") # rome
#' guess_fc(Surnames, Names, Birthdates, Female, Comune_of_birth)
#'
#' @export
guess_fc <- function(surname = NULL,
name = NULL,
birth_date = NULL,
female = NULL,
codice_catastale = NULL)
{
## validate input
if(! is.character(surname))
stop("surname must be a character vector.")
if(! is.character(name))
stop("name must be a character vector.")
if(! inherits(birth_date, "Date"))
stop("birth_date must be a Date vector.")
if(! is.logical(female))
stop("female must be a logical vector.")
if(! is.character(codice_catastale))
stop("codice_catastale must be a character vector.")
## validate lengths
Len <- unlist(lapply(list(surname, name, birth_date,
female, codice_catastale),
length))
if (stats::var(Len) > 0){
stop("all vector must be of the same length")
}
## normalize input
surname <- keepAlpha(surname)
surname[surname %in% ""] <- NA
name <- keepAlpha(name)
name[name %in% ""] <- NA
codice_catastale[codice_catastale %in% ""] <- NA
female <- as.integer(female)
year <- as.integer(format(birth_date, "%Y"))
month <- as.integer(format(birth_date, "%m"))
day <- as.integer(format(birth_date, "%d"))
## locate rows with NAs
NAS <- apply(do.call("rbind",
lapply(list(surname, name, birth_date,
female, codice_catastale),
is.na)),
2, any)
## return value
rval <- rep(NA_character_, Len[1])
rval[!NAS] <- .Call("reg_guess_fc",
surname[!NAS],
name[!NAS],
year[!NAS],
month[!NAS],
day[!NAS],
female[!NAS],
codice_catastale[!NAS],
PACKAGE = "ifctools")
rval
}
keepAlpha <- function(x)
gsub("[^[:alpha:]]", "", toupper(x), perl =TRUE)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.