Skip to content

Commit 1bf8c16

Browse files
robjhyndmanrobjhyndman
committed
2024-36 processed
1 parent 09908b5 commit 1bf8c16

File tree

11 files changed

+4759
-0
lines changed

11 files changed

+4759
-0
lines changed

‎_articles/RJ-2024-036/RJ-2024-036.R

Lines changed: 213 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,213 @@
1+
# Generated by `rjournal_pdf_article()` using `knitr::purl()`: do not edit by hand
2+
# Please edit RJ-2024-036.Rmd to modify this file
3+
4+
## ----setup, include=FALSE-----------------------------------------------------
5+
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, comment = "")
6+
7+
library(kableExtra)
8+
library(xtable)
9+
library(dplyr)
10+
library(tibble)
11+
12+
13+
## ----nin-table----------------------------------------------------------------
14+
nin_table <- tibble(
15+
country = c("Sweden", "Iceland", "Norway", "Denmark", "Finland"),
16+
'NIN name' = c("personnummer", "kennitala", "fødselsnummer", "CPR-nummer", "henkilötunnus"),
17+
introduced = c(1947, 1950, 1964, 1968, 1968),
18+
'characters (n)' = c(11, 10, 11, 11, 11),
19+
'birth date' = c("yes", "yes", "yes", "yes", "yes"),
20+
sex = c("yes", "no", "yes", "yes", "yes"),
21+
'birth place' = c("yes", "no", "no", "no", "no")
22+
)
23+
24+
if (knitr::is_latex_output()) {
25+
kable(nin_table, booktabs = TRUE,
26+
caption = "Nordic NINs: year introduced and embedded information.") %>%
27+
kable_styling(latex_options = "hold_position")
28+
} else {
29+
kable(nin_table, booktabs = TRUE,
30+
caption = "Nordic NINs: year introduced and embedded information.")
31+
}
32+
33+
34+
## ----nin-table2---------------------------------------------------------------
35+
nin_table2 <- tibble(
36+
country = c("Sweden", "Iceland", "Norway", "Denmark", "Finland", "Sweden"),
37+
'NIN name' = c("personnummer", "kennitala", "fødselsnummer", "CPR-nummer", "henkilötunnus", "personnummer (ADB)"),
38+
'NIN example' = c("610321-3499", "121212-1239", "01129955131", "300280-1178", "131052-308T", "196103213499"),
39+
'NIN structure' = c("YYMMDDCNNNQ", "DDMMYYNNQC", "DDMMYYNNNQQ", "DDMMYY-NNNN", "DDMMYYCNNNQ", "YYYYMMDDNNNQ")
40+
)
41+
42+
if (knitr::is_latex_output()) {
43+
kable(nin_table2, caption = "Examples of national identification numbers and their composition in five Nordic countries. DD: day, MM: month, YY: year, C: century marker, N: individual number / serial number, Q: check digit or a control character.", booktabs = TRUE) %>%
44+
kable_styling(latex_options = "hold_position")
45+
} else {
46+
kable(nin_table2, caption = "Examples of national identification numbers and their composition in five Nordic countries. DD: day, MM: month, YY: year, C: century marker, N: individual number / serial number, Q: check digit or a control character.", booktabs = TRUE)
47+
}
48+
49+
50+
## ----function-table-----------------------------------------------------------
51+
function_table <- tibble(
52+
sweidnumbr = c(
53+
"rpin", "pin_age", "luhn_algo", "pin_ctrl",
54+
"pin_date (pin_to_date)", "pin_sex", "oin_ctrl", "roin"
55+
),
56+
hetu = c(
57+
"rpin (rhetu)", "pin_age (hetu_age)", "hetu_control_char",
58+
"pin_ctrl (hetu_ctrl)", "pin_date (hetu_date)",
59+
"pin_sex (hetu_sex)", "bid_ctrl", "rbid"
60+
),
61+
Description = c(
62+
"Generate a vector of random NINs",
63+
"Calculate age from NIN",
64+
"Calculate check digit / control character from NIN",
65+
"Check NIN validity",
66+
"Extract Birth date from NIN",
67+
"Extract Sex from NIN",
68+
"Check OIN/BID validity",
69+
"Generate a vector of random OINs/BIDs"
70+
)
71+
)
72+
73+
if (knitr::is_latex_output()) {
74+
kable(function_table, caption = "Exported functions that are shared between both `sweidnumbr` and `hetu`. Function alias in parentheses.", booktabs = TRUE) %>%
75+
kable_styling(latex_options = "hold_position")
76+
} else {
77+
kable(function_table, caption = "Exported functions that are shared between both `sweidnumbr` and `hetu`. Function alias in parentheses.", booktabs = TRUE)
78+
}
79+
80+
81+
## ----include=TRUE, echo=TRUE, results='hide'----------------------------------
82+
library(hetu)
83+
x <- c("010101A0101", "111111-111C", "290201A010M")
84+
hetu(x)
85+
86+
87+
## ----echo=FALSE---------------------------------------------------------------
88+
hetu(x)
89+
90+
91+
## ----include=TRUE, echo=TRUE--------------------------------------------------
92+
hetu("010101A0101", extract = "sex")
93+
hetu("010101A0101", extract = "date")
94+
95+
96+
## ----include=TRUE, echo=TRUE--------------------------------------------------
97+
pin_sex("010101A0101")
98+
pin_date("010101A0101")
99+
100+
101+
## ----include=TRUE, echo=TRUE--------------------------------------------------
102+
pin_age("010101A0101", date = "2004-02-01", timespan = "months")
103+
104+
105+
## ----include=TRUE, echo=TRUE--------------------------------------------------
106+
hetu_diagnostic("290201A010M")
107+
108+
109+
## ----echo=TRUE, include=TRUE--------------------------------------------------
110+
example_vector <- c("290201A010M", "280201A010M", "290301A010M", "290200A010M")
111+
columns <- c("valid.p.num", "valid.ctrl.char", "correct.ctrl.char", "valid.date")
112+
hetu_diagnostic(example_vector, extract = columns)
113+
114+
115+
## ----include=TRUE, echo=TRUE--------------------------------------------------
116+
set.seed(125)
117+
x <- rpin(n = 4, p.male = 0.25, p.temp = 1.0)
118+
x
119+
pin_ctrl(x)
120+
pin_ctrl(x, allow.temp = TRUE)
121+
122+
123+
## ----include=TRUE, echo=TRUE--------------------------------------------------
124+
bid_ctrl(c("0000000-0", "0000001-9"))
125+
satu_ctrl("10000001N")
126+
127+
128+
## ----hetu-function-table------------------------------------------------------
129+
hetu_function_table <- tibble(
130+
'Function (alias)' = c(
131+
"hetu",
132+
"pin_diagnostic (hetu_diagnostic)",
133+
"satu_control_char",
134+
"satu_ctrl"
135+
),
136+
Description = c(
137+
"Finnish personal identification number extraction",
138+
"Diagnostics Tool for HETU",
139+
"FINUID Number Control Character Calculator",
140+
"Check FINUID Number validity"
141+
)
142+
)
143+
144+
if (knitr::is_latex_output()) {
145+
kable(hetu_function_table, caption = "Functions that are unique to the `hetu` package and have no equivalent in the `sweidnumbr` package. Function alias in parentheses.", booktabs = TRUE) %>%
146+
kable_styling(latex_options = "hold_position")
147+
} else {
148+
kable(hetu_function_table, caption = "Functions that are unique to the `hetu` package and have no equivalent in the `sweidnumbr` package. Function alias in parentheses.", booktabs = TRUE)
149+
}
150+
151+
152+
## ----include=TRUE, echo=TRUE--------------------------------------------------
153+
diagnostics <- hetu_diagnostic(example_vector)
154+
summary(diagnostics)
155+
156+
157+
## ----include=TRUE, echo=TRUE--------------------------------------------------
158+
library(sweidnumbr)
159+
example_pin <- c("640823-3234", "6408233234", "19640823-3230")
160+
example_pin <- as.pin(example_pin)
161+
example_pin
162+
163+
164+
## ----include=TRUE, echo=TRUE--------------------------------------------------
165+
is.pin(example_pin)
166+
167+
168+
## ----include=TRUE, echo=TRUE--------------------------------------------------
169+
pin_ctrl(example_pin)
170+
171+
172+
## ----include=TRUE, echo=TRUE--------------------------------------------------
173+
pin_sex(example_pin)
174+
pin_birthplace(example_pin)
175+
pin_age(example_pin)
176+
pin_age(example_pin, date = "2000-01-01")
177+
178+
179+
## ----include=TRUE, echo=TRUE--------------------------------------------------
180+
example_oin <- c("556000-4615", "232100-0156", "802002-4280")
181+
oin_group(example_oin)
182+
183+
184+
## ----include=TRUE, echo=TRUE--------------------------------------------------
185+
set.seed(125)
186+
roin(3)
187+
188+
189+
## ----swe-function-table-------------------------------------------------------
190+
sweidnumbr_function_table <- tibble(
191+
Function = c(
192+
"as.oin", "as.pin", "format_pin", "is.oin",
193+
"is.pin", "oin_group", "pin_birthplace", "pin_coordn"
194+
),
195+
Description = c(
196+
"Parse organizational identity numbers",
197+
"Parse personal identity numbers to ADP format",
198+
"Formatting pin",
199+
"Test if a character vector contains correct 'oin'",
200+
"Parse personal identity numbers to ADP format",
201+
"Calculate organization group from 'oin'",
202+
"Calculate the birthplace of 'pin'",
203+
"Check if 'pin' is a coordination number"
204+
)
205+
)
206+
207+
if (knitr::is_latex_output()) {
208+
kable(sweidnumbr_function_table, caption = "Functions that are unique to the `sweidnumbr` package and have no equivalent in the `hetu` package.", booktabs = TRUE) %>%
209+
kable_styling(latex_options = "hold_position")
210+
} else {
211+
kable(sweidnumbr_function_table, caption = "Functions that are unique to the `sweidnumbr` package and have no equivalent in the `hetu` package.", booktabs = TRUE)
212+
}
213+

0 commit comments

Comments
 (0)