diff --git a/README.md b/README.md index e29fb3161..bdfe58993 100644 --- a/README.md +++ b/README.md @@ -1,14 +1,14 @@ # You can find the book at http://asdfree.com/ american-community-survey-acs:

Github Actions Badge

american-housing-survey-ahs:

Github Actions Badge

-american-national-election-studies-anes:

Local Testing Badge

+american-national-election-studies-anes:

Local Testing Badge

american-time-use-survey-atus:

Github Actions Badge

area-health-resources-files-ahrf:

Github Actions Badge

behavioral-risk-factor-surveillance-system-brfss:

Github Actions Badge

census-of-governments-cog:

Github Actions Badge

consumer-expenditure-survey-ces:

Github Actions Badge

current-population-survey-cps:

Github Actions Badge

-european-social-survey-ess:

Local Testing Badge

+european-social-survey-ess:

Local Testing Badge

exame-nacional-de-desempenho-de-estudantes-enade:

Github Actions Badge

exame-nacional-do-ensino-medio-enem:

Github Actions Badge

fda-adverse-event-reporting-system-faers:

Github Actions Badge

diff --git a/asdfree_cache/html/__packages b/asdfree_cache/html/__packages index 9692d08f5..7234216d1 100644 --- a/asdfree_cache/html/__packages +++ b/asdfree_cache/html/__packages @@ -1,12 +1,7 @@ -httr -archive -readr -DBI -duckdb +haven bookdown rmarkdown stringr -haven Matrix survival survey diff --git a/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.RData b/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.RData index eb05811ee..d83a64b9e 100644 Binary files a/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.RData and b/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.rdb b/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.rdb index 188e40aa0..cfb05b04f 100644 Binary files a/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.rdb and b/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.rdb differ diff --git a/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.rdx b/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.rdx index 7919261fc..355dafac4 100644 Binary files a/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.rdx and b/asdfree_cache/html/unnamed-chunk-104_250d5a2bdd7c185b00047194b705ae69.rdx differ diff --git a/asdfree_cache/html/unnamed-chunk-105_2801f2c9a9595e51922a9d74fc003a9d.RData b/asdfree_cache/html/unnamed-chunk-105_2801f2c9a9595e51922a9d74fc003a9d.RData index 74e8bdd08..e5f6ce601 100644 Binary files a/asdfree_cache/html/unnamed-chunk-105_2801f2c9a9595e51922a9d74fc003a9d.RData and b/asdfree_cache/html/unnamed-chunk-105_2801f2c9a9595e51922a9d74fc003a9d.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-106_9f1ede49675ee402cfb963adb1563e31.RData b/asdfree_cache/html/unnamed-chunk-106_9f1ede49675ee402cfb963adb1563e31.RData index e119233b7..5431c10bf 100644 Binary files a/asdfree_cache/html/unnamed-chunk-106_9f1ede49675ee402cfb963adb1563e31.RData and b/asdfree_cache/html/unnamed-chunk-106_9f1ede49675ee402cfb963adb1563e31.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-107_327df253fa7251ead92db81ad073434c.RData b/asdfree_cache/html/unnamed-chunk-107_327df253fa7251ead92db81ad073434c.RData index 39d72920a..ca788ed63 100644 Binary files a/asdfree_cache/html/unnamed-chunk-107_327df253fa7251ead92db81ad073434c.RData and b/asdfree_cache/html/unnamed-chunk-107_327df253fa7251ead92db81ad073434c.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-108_be05e9cb97e972e0097aedfa100ef96d.RData b/asdfree_cache/html/unnamed-chunk-108_be05e9cb97e972e0097aedfa100ef96d.RData index fd441da37..a18432834 100644 Binary files a/asdfree_cache/html/unnamed-chunk-108_be05e9cb97e972e0097aedfa100ef96d.RData and b/asdfree_cache/html/unnamed-chunk-108_be05e9cb97e972e0097aedfa100ef96d.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-109_7ad31442e4f50097b9c175faff66b5a6.RData b/asdfree_cache/html/unnamed-chunk-109_7ad31442e4f50097b9c175faff66b5a6.RData index 2eb2a6040..14a94dd01 100644 Binary files a/asdfree_cache/html/unnamed-chunk-109_7ad31442e4f50097b9c175faff66b5a6.RData and b/asdfree_cache/html/unnamed-chunk-109_7ad31442e4f50097b9c175faff66b5a6.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-110_cdb997fe17aa58ab7a854b982a9947a5.RData b/asdfree_cache/html/unnamed-chunk-110_cdb997fe17aa58ab7a854b982a9947a5.RData index 40b505d19..0d87930aa 100644 Binary files a/asdfree_cache/html/unnamed-chunk-110_cdb997fe17aa58ab7a854b982a9947a5.RData and b/asdfree_cache/html/unnamed-chunk-110_cdb997fe17aa58ab7a854b982a9947a5.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-111_2033c59c83fbb9f36ff7536bf52f3f1b.RData b/asdfree_cache/html/unnamed-chunk-111_2033c59c83fbb9f36ff7536bf52f3f1b.RData index ac59c8000..7ac3ac1a7 100644 Binary files a/asdfree_cache/html/unnamed-chunk-111_2033c59c83fbb9f36ff7536bf52f3f1b.RData and b/asdfree_cache/html/unnamed-chunk-111_2033c59c83fbb9f36ff7536bf52f3f1b.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-112_b3e2682aa2e4918cca11d7d7189ada83.RData b/asdfree_cache/html/unnamed-chunk-112_b3e2682aa2e4918cca11d7d7189ada83.RData index c6d00c73e..f170c9cdf 100644 Binary files a/asdfree_cache/html/unnamed-chunk-112_b3e2682aa2e4918cca11d7d7189ada83.RData and b/asdfree_cache/html/unnamed-chunk-112_b3e2682aa2e4918cca11d7d7189ada83.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-113_09e4d6068e42463f74becf6a3f8baec1.RData b/asdfree_cache/html/unnamed-chunk-113_09e4d6068e42463f74becf6a3f8baec1.RData index e00882253..1870007e3 100644 Binary files a/asdfree_cache/html/unnamed-chunk-113_09e4d6068e42463f74becf6a3f8baec1.RData and b/asdfree_cache/html/unnamed-chunk-113_09e4d6068e42463f74becf6a3f8baec1.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-114_40864cea57f35b86fec389a2ff48867a.RData b/asdfree_cache/html/unnamed-chunk-114_40864cea57f35b86fec389a2ff48867a.RData index 8589d97a6..ca0b83ee5 100644 Binary files a/asdfree_cache/html/unnamed-chunk-114_40864cea57f35b86fec389a2ff48867a.RData and b/asdfree_cache/html/unnamed-chunk-114_40864cea57f35b86fec389a2ff48867a.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-115_358516783a8e44220432a3d12a0ba4f3.RData b/asdfree_cache/html/unnamed-chunk-115_358516783a8e44220432a3d12a0ba4f3.RData index d35ec99b9..ea7b75fa7 100644 Binary files a/asdfree_cache/html/unnamed-chunk-115_358516783a8e44220432a3d12a0ba4f3.RData and b/asdfree_cache/html/unnamed-chunk-115_358516783a8e44220432a3d12a0ba4f3.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-116_b961a559209d7a08887090e3dc673736.RData b/asdfree_cache/html/unnamed-chunk-116_b961a559209d7a08887090e3dc673736.RData index e42e293c9..2300f9bad 100644 Binary files a/asdfree_cache/html/unnamed-chunk-116_b961a559209d7a08887090e3dc673736.RData and b/asdfree_cache/html/unnamed-chunk-116_b961a559209d7a08887090e3dc673736.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-117_26709a1fdc0a0fc373580c83527b9b4a.RData b/asdfree_cache/html/unnamed-chunk-117_26709a1fdc0a0fc373580c83527b9b4a.RData index 04d838f5f..90ee2a787 100644 Binary files a/asdfree_cache/html/unnamed-chunk-117_26709a1fdc0a0fc373580c83527b9b4a.RData and b/asdfree_cache/html/unnamed-chunk-117_26709a1fdc0a0fc373580c83527b9b4a.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-118_fbce4adc230c01bba3a7e12841b6b500.RData b/asdfree_cache/html/unnamed-chunk-118_fbce4adc230c01bba3a7e12841b6b500.RData index 67a2601c6..4789fe9b2 100644 Binary files a/asdfree_cache/html/unnamed-chunk-118_fbce4adc230c01bba3a7e12841b6b500.RData and b/asdfree_cache/html/unnamed-chunk-118_fbce4adc230c01bba3a7e12841b6b500.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-119_2d021156ddf8cc0cece43a30c25a6d61.RData b/asdfree_cache/html/unnamed-chunk-119_2d021156ddf8cc0cece43a30c25a6d61.RData index db4697894..7c3b13bab 100644 Binary files a/asdfree_cache/html/unnamed-chunk-119_2d021156ddf8cc0cece43a30c25a6d61.RData and b/asdfree_cache/html/unnamed-chunk-119_2d021156ddf8cc0cece43a30c25a6d61.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-120_4c48432abd5dec3cf405500c8a573193.RData b/asdfree_cache/html/unnamed-chunk-120_4c48432abd5dec3cf405500c8a573193.RData index 82de30373..5579f7af6 100644 Binary files a/asdfree_cache/html/unnamed-chunk-120_4c48432abd5dec3cf405500c8a573193.RData and b/asdfree_cache/html/unnamed-chunk-120_4c48432abd5dec3cf405500c8a573193.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-121_7b2350956db83a4b76d678398f22f6f9.RData b/asdfree_cache/html/unnamed-chunk-121_7b2350956db83a4b76d678398f22f6f9.RData index aaaadd1f4..f47160aa7 100644 Binary files a/asdfree_cache/html/unnamed-chunk-121_7b2350956db83a4b76d678398f22f6f9.RData and b/asdfree_cache/html/unnamed-chunk-121_7b2350956db83a4b76d678398f22f6f9.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-122_765dde5e3ccb9beffe4761550a8448d7.RData b/asdfree_cache/html/unnamed-chunk-122_765dde5e3ccb9beffe4761550a8448d7.RData index b67553e14..4571ea46d 100644 Binary files a/asdfree_cache/html/unnamed-chunk-122_765dde5e3ccb9beffe4761550a8448d7.RData and b/asdfree_cache/html/unnamed-chunk-122_765dde5e3ccb9beffe4761550a8448d7.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-123_afe79353b79e3fe0ce0aa9cc84ca6c68.RData b/asdfree_cache/html/unnamed-chunk-123_afe79353b79e3fe0ce0aa9cc84ca6c68.RData index 8f18a4f51..b2d17bfa3 100644 Binary files a/asdfree_cache/html/unnamed-chunk-123_afe79353b79e3fe0ce0aa9cc84ca6c68.RData and b/asdfree_cache/html/unnamed-chunk-123_afe79353b79e3fe0ce0aa9cc84ca6c68.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-124_33c31c9713f03772dbd3155458439600.RData b/asdfree_cache/html/unnamed-chunk-124_33c31c9713f03772dbd3155458439600.RData index 54d7ecb53..639cd18de 100644 Binary files a/asdfree_cache/html/unnamed-chunk-124_33c31c9713f03772dbd3155458439600.RData and b/asdfree_cache/html/unnamed-chunk-124_33c31c9713f03772dbd3155458439600.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-125_36c93fec1f77ff863bfacc9cd05084d3.RData b/asdfree_cache/html/unnamed-chunk-125_36c93fec1f77ff863bfacc9cd05084d3.RData index 9f86d6010..709f5f13c 100644 Binary files a/asdfree_cache/html/unnamed-chunk-125_36c93fec1f77ff863bfacc9cd05084d3.RData and b/asdfree_cache/html/unnamed-chunk-125_36c93fec1f77ff863bfacc9cd05084d3.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-126_e3b4defe611be960f1fec799cd343a15.RData b/asdfree_cache/html/unnamed-chunk-126_e3b4defe611be960f1fec799cd343a15.RData index ff1e8eb3e..de92b88cd 100644 Binary files a/asdfree_cache/html/unnamed-chunk-126_e3b4defe611be960f1fec799cd343a15.RData and b/asdfree_cache/html/unnamed-chunk-126_e3b4defe611be960f1fec799cd343a15.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-127_6f5ad59cff2edbf9038398d3a81d8ab3.RData b/asdfree_cache/html/unnamed-chunk-127_6f5ad59cff2edbf9038398d3a81d8ab3.RData index 193948456..c9ef9596c 100644 Binary files a/asdfree_cache/html/unnamed-chunk-127_6f5ad59cff2edbf9038398d3a81d8ab3.RData and b/asdfree_cache/html/unnamed-chunk-127_6f5ad59cff2edbf9038398d3a81d8ab3.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-128_79c0286f03060fba9393f6a6a83c8449.RData b/asdfree_cache/html/unnamed-chunk-128_79c0286f03060fba9393f6a6a83c8449.RData index b35dad205..d491a4fe6 100644 Binary files a/asdfree_cache/html/unnamed-chunk-128_79c0286f03060fba9393f6a6a83c8449.RData and b/asdfree_cache/html/unnamed-chunk-128_79c0286f03060fba9393f6a6a83c8449.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-129_73b774f02b33a4fec6d120fdb8aa7992.RData b/asdfree_cache/html/unnamed-chunk-129_73b774f02b33a4fec6d120fdb8aa7992.RData index 6595f70f3..0eb09c314 100644 Binary files a/asdfree_cache/html/unnamed-chunk-129_73b774f02b33a4fec6d120fdb8aa7992.RData and b/asdfree_cache/html/unnamed-chunk-129_73b774f02b33a4fec6d120fdb8aa7992.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-130_85ca9d9221dfc5f8d2511b4827fbd2f6.RData b/asdfree_cache/html/unnamed-chunk-130_85ca9d9221dfc5f8d2511b4827fbd2f6.RData index a37fd2dfd..78a851769 100644 Binary files a/asdfree_cache/html/unnamed-chunk-130_85ca9d9221dfc5f8d2511b4827fbd2f6.RData and b/asdfree_cache/html/unnamed-chunk-130_85ca9d9221dfc5f8d2511b4827fbd2f6.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-131_99a8c990f580913fc9a1d0dfb9ae9bef.RData b/asdfree_cache/html/unnamed-chunk-131_99a8c990f580913fc9a1d0dfb9ae9bef.RData index 471451307..39b1d38b7 100644 Binary files a/asdfree_cache/html/unnamed-chunk-131_99a8c990f580913fc9a1d0dfb9ae9bef.RData and b/asdfree_cache/html/unnamed-chunk-131_99a8c990f580913fc9a1d0dfb9ae9bef.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-335_d0795eb8bd8229eb923ef99d9c9b23d9.RData b/asdfree_cache/html/unnamed-chunk-335_d0795eb8bd8229eb923ef99d9c9b23d9.RData index f45d56778..eb4571dca 100644 Binary files a/asdfree_cache/html/unnamed-chunk-335_d0795eb8bd8229eb923ef99d9c9b23d9.RData and b/asdfree_cache/html/unnamed-chunk-335_d0795eb8bd8229eb923ef99d9c9b23d9.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-336_31faef7cd2bdfddd2fbb60a33109abd3.RData b/asdfree_cache/html/unnamed-chunk-336_31faef7cd2bdfddd2fbb60a33109abd3.RData index 2d9725329..eb50255c6 100644 Binary files a/asdfree_cache/html/unnamed-chunk-336_31faef7cd2bdfddd2fbb60a33109abd3.RData and b/asdfree_cache/html/unnamed-chunk-336_31faef7cd2bdfddd2fbb60a33109abd3.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-337_9f51e8f7a697a9db128bf1977d7c0d08.RData b/asdfree_cache/html/unnamed-chunk-337_9f51e8f7a697a9db128bf1977d7c0d08.RData index 1ab4b096f..5277a843a 100644 Binary files a/asdfree_cache/html/unnamed-chunk-337_9f51e8f7a697a9db128bf1977d7c0d08.RData and b/asdfree_cache/html/unnamed-chunk-337_9f51e8f7a697a9db128bf1977d7c0d08.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-338_9e40f51f7c58e2d8d0f339063131b6cd.RData b/asdfree_cache/html/unnamed-chunk-338_9e40f51f7c58e2d8d0f339063131b6cd.RData index ba2415cb2..9b6c0f6d6 100644 Binary files a/asdfree_cache/html/unnamed-chunk-338_9e40f51f7c58e2d8d0f339063131b6cd.RData and b/asdfree_cache/html/unnamed-chunk-338_9e40f51f7c58e2d8d0f339063131b6cd.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-339_0d8e4285cf70d6ff304bb7c5c4f43e7b.RData b/asdfree_cache/html/unnamed-chunk-339_0d8e4285cf70d6ff304bb7c5c4f43e7b.RData index b565708e6..f81d66c5e 100644 Binary files a/asdfree_cache/html/unnamed-chunk-339_0d8e4285cf70d6ff304bb7c5c4f43e7b.RData and b/asdfree_cache/html/unnamed-chunk-339_0d8e4285cf70d6ff304bb7c5c4f43e7b.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-340_6d8d2b88e90990fa39944abdb1334932.RData b/asdfree_cache/html/unnamed-chunk-340_6d8d2b88e90990fa39944abdb1334932.RData index 2ebf66cc2..b35e29d93 100644 Binary files a/asdfree_cache/html/unnamed-chunk-340_6d8d2b88e90990fa39944abdb1334932.RData and b/asdfree_cache/html/unnamed-chunk-340_6d8d2b88e90990fa39944abdb1334932.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-341_6d75e9c3d0e36bc42b9f4caba9fcce89.RData b/asdfree_cache/html/unnamed-chunk-341_6d75e9c3d0e36bc42b9f4caba9fcce89.RData index 3bb6aa886..8b6b8b3ff 100644 Binary files a/asdfree_cache/html/unnamed-chunk-341_6d75e9c3d0e36bc42b9f4caba9fcce89.RData and b/asdfree_cache/html/unnamed-chunk-341_6d75e9c3d0e36bc42b9f4caba9fcce89.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-342_26b7c543c948ac84b2e8de4f5ad98147.RData b/asdfree_cache/html/unnamed-chunk-342_26b7c543c948ac84b2e8de4f5ad98147.RData index c5a3f5e15..dca57ff24 100644 Binary files a/asdfree_cache/html/unnamed-chunk-342_26b7c543c948ac84b2e8de4f5ad98147.RData and b/asdfree_cache/html/unnamed-chunk-342_26b7c543c948ac84b2e8de4f5ad98147.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-343_5d64e91e5f6b7d35aad9ab655e2f05d6.RData b/asdfree_cache/html/unnamed-chunk-343_5d64e91e5f6b7d35aad9ab655e2f05d6.RData index a47cb98ba..927269e44 100644 Binary files a/asdfree_cache/html/unnamed-chunk-343_5d64e91e5f6b7d35aad9ab655e2f05d6.RData and b/asdfree_cache/html/unnamed-chunk-343_5d64e91e5f6b7d35aad9ab655e2f05d6.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-344_27cf50723ce5095089ca13d9e30b9915.RData b/asdfree_cache/html/unnamed-chunk-344_27cf50723ce5095089ca13d9e30b9915.RData index 66a14cc51..92a6f6173 100644 Binary files a/asdfree_cache/html/unnamed-chunk-344_27cf50723ce5095089ca13d9e30b9915.RData and b/asdfree_cache/html/unnamed-chunk-344_27cf50723ce5095089ca13d9e30b9915.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-345_192eebbe92b08076f1b5c8274d3d4365.RData b/asdfree_cache/html/unnamed-chunk-345_192eebbe92b08076f1b5c8274d3d4365.RData index 94d1a67d5..a4ae3ddd6 100644 Binary files a/asdfree_cache/html/unnamed-chunk-345_192eebbe92b08076f1b5c8274d3d4365.RData and b/asdfree_cache/html/unnamed-chunk-345_192eebbe92b08076f1b5c8274d3d4365.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-346_9f15779a7eae70fef6bb06997118df1f.RData b/asdfree_cache/html/unnamed-chunk-346_9f15779a7eae70fef6bb06997118df1f.RData index a90d761c9..26a935df3 100644 Binary files a/asdfree_cache/html/unnamed-chunk-346_9f15779a7eae70fef6bb06997118df1f.RData and b/asdfree_cache/html/unnamed-chunk-346_9f15779a7eae70fef6bb06997118df1f.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-347_4c87fb96fd2ffc67ace58923d93ab1ac.RData b/asdfree_cache/html/unnamed-chunk-347_4c87fb96fd2ffc67ace58923d93ab1ac.RData index f8b6a6a0f..ddcc6d016 100644 Binary files a/asdfree_cache/html/unnamed-chunk-347_4c87fb96fd2ffc67ace58923d93ab1ac.RData and b/asdfree_cache/html/unnamed-chunk-347_4c87fb96fd2ffc67ace58923d93ab1ac.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-348_2fe3bc207c08cc7837232e2ff65e242f.RData b/asdfree_cache/html/unnamed-chunk-348_2fe3bc207c08cc7837232e2ff65e242f.RData index a04db6dae..599b335c2 100644 Binary files a/asdfree_cache/html/unnamed-chunk-348_2fe3bc207c08cc7837232e2ff65e242f.RData and b/asdfree_cache/html/unnamed-chunk-348_2fe3bc207c08cc7837232e2ff65e242f.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-349_74cd4a2d48d5ff52068b361f5cc57f5a.RData b/asdfree_cache/html/unnamed-chunk-349_74cd4a2d48d5ff52068b361f5cc57f5a.RData index 640afcce4..108ee7e92 100644 Binary files a/asdfree_cache/html/unnamed-chunk-349_74cd4a2d48d5ff52068b361f5cc57f5a.RData and b/asdfree_cache/html/unnamed-chunk-349_74cd4a2d48d5ff52068b361f5cc57f5a.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-350_0babca9527f69d1c7838aca882fdbd12.RData b/asdfree_cache/html/unnamed-chunk-350_0babca9527f69d1c7838aca882fdbd12.RData index 40f808a44..66feb99c9 100644 Binary files a/asdfree_cache/html/unnamed-chunk-350_0babca9527f69d1c7838aca882fdbd12.RData and b/asdfree_cache/html/unnamed-chunk-350_0babca9527f69d1c7838aca882fdbd12.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-351_0ffcfc27549001e8181ac058afd64ebd.RData b/asdfree_cache/html/unnamed-chunk-351_0ffcfc27549001e8181ac058afd64ebd.RData index 3006f0700..0070aa864 100644 Binary files a/asdfree_cache/html/unnamed-chunk-351_0ffcfc27549001e8181ac058afd64ebd.RData and b/asdfree_cache/html/unnamed-chunk-351_0ffcfc27549001e8181ac058afd64ebd.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-352_d6991b638652613ba787849044c5844c.RData b/asdfree_cache/html/unnamed-chunk-352_d6991b638652613ba787849044c5844c.RData index b1b87c9ee..7d53eefc6 100644 Binary files a/asdfree_cache/html/unnamed-chunk-352_d6991b638652613ba787849044c5844c.RData and b/asdfree_cache/html/unnamed-chunk-352_d6991b638652613ba787849044c5844c.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-353_d40d054372bef7c9c092041337228cce.RData b/asdfree_cache/html/unnamed-chunk-353_d40d054372bef7c9c092041337228cce.RData index d38fd5fe6..c0dfa058e 100644 Binary files a/asdfree_cache/html/unnamed-chunk-353_d40d054372bef7c9c092041337228cce.RData and b/asdfree_cache/html/unnamed-chunk-353_d40d054372bef7c9c092041337228cce.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-354_a4a5fdfc6880d69cc7e60df494f3589a.RData b/asdfree_cache/html/unnamed-chunk-354_a4a5fdfc6880d69cc7e60df494f3589a.RData index a4a3b5106..7620a43c7 100644 Binary files a/asdfree_cache/html/unnamed-chunk-354_a4a5fdfc6880d69cc7e60df494f3589a.RData and b/asdfree_cache/html/unnamed-chunk-354_a4a5fdfc6880d69cc7e60df494f3589a.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-355_d9cb2056e49e6d75ae48f3c2716a14f2.RData b/asdfree_cache/html/unnamed-chunk-355_d9cb2056e49e6d75ae48f3c2716a14f2.RData index d41cd90c0..1ef030877 100644 Binary files a/asdfree_cache/html/unnamed-chunk-355_d9cb2056e49e6d75ae48f3c2716a14f2.RData and b/asdfree_cache/html/unnamed-chunk-355_d9cb2056e49e6d75ae48f3c2716a14f2.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-356_81e7c26308c5aecf874e6bd017bb2e30.RData b/asdfree_cache/html/unnamed-chunk-356_81e7c26308c5aecf874e6bd017bb2e30.RData index ed2f7b745..b4fb1fe76 100644 Binary files a/asdfree_cache/html/unnamed-chunk-356_81e7c26308c5aecf874e6bd017bb2e30.RData and b/asdfree_cache/html/unnamed-chunk-356_81e7c26308c5aecf874e6bd017bb2e30.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-357_93faac4ceb02cc8de0440aeec396629c.RData b/asdfree_cache/html/unnamed-chunk-357_93faac4ceb02cc8de0440aeec396629c.RData index 023a8e4d1..74e0c1a13 100644 Binary files a/asdfree_cache/html/unnamed-chunk-357_93faac4ceb02cc8de0440aeec396629c.RData and b/asdfree_cache/html/unnamed-chunk-357_93faac4ceb02cc8de0440aeec396629c.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-358_304ee430dcea8815ad6323e4ba60f897.RData b/asdfree_cache/html/unnamed-chunk-358_304ee430dcea8815ad6323e4ba60f897.RData index 2c6658714..0ee0076e7 100644 Binary files a/asdfree_cache/html/unnamed-chunk-358_304ee430dcea8815ad6323e4ba60f897.RData and b/asdfree_cache/html/unnamed-chunk-358_304ee430dcea8815ad6323e4ba60f897.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-359_3cf3b4a4d58def1f86a8e1ebe43b1379.RData b/asdfree_cache/html/unnamed-chunk-359_3cf3b4a4d58def1f86a8e1ebe43b1379.RData index b692a97e3..edef2e4f9 100644 Binary files a/asdfree_cache/html/unnamed-chunk-359_3cf3b4a4d58def1f86a8e1ebe43b1379.RData and b/asdfree_cache/html/unnamed-chunk-359_3cf3b4a4d58def1f86a8e1ebe43b1379.RData differ diff --git a/asdfree_cache/html/unnamed-chunk-360_536558ff3c529f715784de2427dee2a8.RData b/asdfree_cache/html/unnamed-chunk-360_536558ff3c529f715784de2427dee2a8.RData index c07506ac1..dcd521e94 100644 Binary files a/asdfree_cache/html/unnamed-chunk-360_536558ff3c529f715784de2427dee2a8.RData and b/asdfree_cache/html/unnamed-chunk-360_536558ff3c529f715784de2427dee2a8.RData differ diff --git a/brfss.Rmd b/brfss.Rmd index 1833eb2d4..dad9f3351 100644 --- a/brfss.Rmd +++ b/brfss.Rmd @@ -38,7 +38,7 @@ library(haven) zip_tf <- tempfile() -zip_url <- "https://www.cdc.gov/brfss/annual_data/2021/files/LLCP2021XPT.zip" +zip_url <- "https://www.cdc.gov/brfss/annual_data/2022/files/LLCP2022XPT.zip" download.file( zip_url , zip_tf , mode = 'wb' ) @@ -327,7 +327,7 @@ summary( glm_result ) ## Replication Example {-} -This example matches Alaska's confidence intervals from the [BRFSS Prevalence & Trends Data](https://nccd.cdc.gov/BRFSSPrevalence/rdPage.aspx?rdReport=DPH_BRFSS.ExploreByTopic&irbLocationType=StatesAndMMSA&islClass=CLASS07&islTopic=TOPIC28&islYear=2021&rdRnd=24558): +This example matches Alaska's confidence intervals from the [BRFSS Prevalence & Trends Data](https://nccd.cdc.gov/BRFSSPrevalence/rdPage.aspx?rdReport=DPH_BRFSS.ExploreByTopic&irbLocationType=StatesAndMMSA&islClass=CLASS07&islTopic=TOPIC28&islYear=2022&rdRnd=24558): ```{r eval = FALSE , results = "hide" } @@ -342,10 +342,10 @@ result <- na.rm = TRUE ) -stopifnot( round( confint( result )[ 1 , 1 ] , 3 ) == 0.094 ) -stopifnot( round( confint( result )[ 1 , 2 ] , 3 ) == 0.122 ) -stopifnot( round( confint( result )[ 2 , 1 ] , 3 ) == 0.878 ) -stopifnot( round( confint( result )[ 2 , 2 ] , 3 ) == 0.906 ) +stopifnot( round( confint( result )[ 1 , 1 ] , 3 ) == 0.092 ) +stopifnot( round( confint( result )[ 1 , 2 ] , 3 ) == 0.114 ) +stopifnot( round( confint( result )[ 2 , 1 ] , 3 ) == 0.886 ) +stopifnot( round( confint( result )[ 2 , 2 ] , 3 ) == 0.908 ) ``` diff --git a/docs/american-national-election-studies-anes.html b/docs/american-national-election-studies-anes.html index fc4f8645f..6e1c5b59a 100644 --- a/docs/american-national-election-studies-anes.html +++ b/docs/american-national-election-studies-anes.html @@ -992,7 +992,7 @@

American National Election Studies (ANES)

-

Local Testing Badge

+

Local Testing Badge

A time series recording belief, public opinion, and political participation back to Dewey vs. Truman.

  • Most tables contain one row per sampled eligible voter, varying weights like pre- and post-election.

    • diff --git a/docs/behavioral-risk-factor-surveillance-system-brfss.html b/docs/behavioral-risk-factor-surveillance-system-brfss.html index 947475dae..9f7eb9704 100644 --- a/docs/behavioral-risk-factor-surveillance-system-brfss.html +++ b/docs/behavioral-risk-factor-surveillance-system-brfss.html @@ -1018,7 +1018,7 @@

    Download, Import, Preparation zip_tf <- tempfile() -zip_url <- "https://www.cdc.gov/brfss/annual_data/2021/files/LLCP2021XPT.zip" +zip_url <- "https://www.cdc.gov/brfss/annual_data/2022/files/LLCP2022XPT.zip" download.file( zip_url , zip_tf , mode = 'wb' ) @@ -1240,7 +1240,7 @@

    Regression Models and Tests of Association

    Replication Example

    -

    This example matches Alaska’s confidence intervals from the BRFSS Prevalence & Trends Data:

    +

    This example matches Alaska’s confidence intervals from the BRFSS Prevalence & Trends Data:

    result <-
     svymean(
         ~ no_doc_visit_due_to_cost ,
@@ -1252,10 +1252,10 @@ 
    Replication Example        na.rm = TRUE
     )
 
-stopifnot( round( confint( result )[ 1 , 1 ] , 3 ) == 0.094 )
-stopifnot( round( confint( result )[ 1 , 2 ] , 3 ) == 0.122 )
-stopifnot( round( confint( result )[ 2 , 1 ] , 3 ) == 0.878 )
-stopifnot( round( confint( result )[ 2 , 2 ] , 3 ) == 0.906 )
    +stopifnot( round( confint( result )[ 1 , 1 ] , 3 ) == 0.092 ) +stopifnot( round( confint( result )[ 1 , 2 ] , 3 ) == 0.114 ) +stopifnot( round( confint( result )[ 2 , 1 ] , 3 ) == 0.886 ) +stopifnot( round( confint( result )[ 2 , 2 ] , 3 ) == 0.908 )

diff --git a/docs/european-social-survey-ess.html b/docs/european-social-survey-ess.html index 8d314970a..9fbc2ec07 100644 --- a/docs/european-social-survey-ess.html +++ b/docs/european-social-survey-ess.html @@ -992,7 +992,7 @@

European Social Survey (ESS)

-

Local Testing Badge

+

Local Testing Badge

The barometer of political opinion and behavior across the continent.

  • One table per country with one row per sampled respondent.

    • diff --git a/docs/search_index.json b/docs/search_index.json index 0f7d08fae..af8360d5d 100644 --- a/docs/search_index.json +++ b/docs/search_index.json @@ -1 +1 @@ -[["index.html", "Analyze Survey Data for Free Forty-One Public Microdatasets To Analyze Before You Die From An Easy To Type Website", " Analyze Survey Data for Free Forty-One Public Microdatasets To Analyze Before You Die From An Easy To Type Website Please ask questions about this book at stackoverflow.com with the R and survey tags. This book replaces my archived blog, prior code, and the no longer maintained lodown package. A work of R is never finished, merely abandoned. - Anthony Damico "],["trend-analysis-of-complex-survey-data.html", "Trend Analysis of Complex Survey Data Download, Import, Preparation Append Polynomials to Each Year Unadjusted Analysis Examples Calculate Joinpoints Needed Calculate Predicted Marginals Identify Joinpoint(s) or Breakpoint(s) Interpret and Conclude", " Trend Analysis of Complex Survey Data The purpose of this analysis is to make statistically valid statements such as, “there was a significant linear decrease in the prevalence of high school aged americans who have ever smoked a cigarette across the period 1999-2011” with complex sample survey data. This step-by-step walkthrough exactly reproduces the statistics presented in the Center for Disease Control & Prevention’s (CDC) linear trend analysis. This analysis may complement qualitative evaluation on prevalence changes observed from surveillance data by providing quantitative evidence, such as when a joinpoint (also called breakpoint or changepoint) occurred; however, this analysis does not explain why or how changes in trends occur. Download, Import, Preparation Download and import the multi-year stacked file: library(SAScii) library(readr) sas_url <- "https://www.cdc.gov/healthyyouth/data/yrbs/sadc_2019/2019-SADC-SAS-Input-Program.sas" dat_url <- "https://www.cdc.gov/healthyyouth/data/yrbs/sadc_2019/sadc_2019_national.dat" sas_positions <- parse.SAScii( sas_url ) sas_positions[ , 'varname' ] <- tolower( sas_positions[ , 'varname' ] ) variables_to_keep <- c( "sex" , "grade" , "race4" , "q30" , "year" , "psu" , "stratum" , "weight" ) sas_positions[ , 'column_types' ] <- ifelse( !( sas_positions[ , 'varname' ] %in% variables_to_keep ) , "_" , ifelse( sas_positions[ , 'char' ] , "c" , "d" ) ) yrbss_tbl <- read_fwf( dat_url , fwf_widths( abs( sas_positions[ , 'width' ] ) , col_names = sas_positions[ , 'varname' ] ) , col_types = paste0( sas_positions[ , 'column_types' ] , collapse = "" ) , na = c( "" , "." ) ) yrbss_df <- data.frame( yrbss_tbl ) Restrict the dataset to only years shown in the original analysis and re-name the main variable: yrbss_df <- subset( yrbss_df , year %in% seq( 1991 , 2011 , 2 ) ) yrbss_df[ , 'ever_smoked' ] <- as.numeric( yrbss_df[ , 'q30' ] == 1 ) yrbss_df[ , 'q30' ] <- NULL Recode each categorical variable to factor class: yrbss_df[ , 'sex' ] <- relevel( factor( yrbss_df[ , 'sex' ] ) , ref = "2" ) for ( i in c( 'race4' , 'grade' ) ){ yrbss_df[ , i ] <- relevel( factor( yrbss_df[ , i ] ) , ref = "1" ) } Append Polynomials to Each Year “The polynomials we have used as predictors to this point are natural polynomials, generated from the linear predictor by centering and then powering the linear predictor.” For more detail on this subject, see page 216 of Applied Multiple Regression/Correlation Analysis for the Behavioral Sciences By Jacob Cohen, Patricia Cohen, Stephen G. West, Leona S. Aiken distinct_years_available <- length( seq( 1991 , 2011 , 2 ) ) # store the linear polynomials c11l <- contr.poly( distinct_years_available )[ , ".L" ] # store the quadratic polynomials c11q <- contr.poly( distinct_years_available )[ , ".Q" ] # store the cubic polynomials c11c <- contr.poly( distinct_years_available )[ , ".C" ] For each record in the data set, tack on the linear, quadratic, and cubic contrast value, these contrast values will serve as replacement for the linear year variable in any regression: # year^1 term (linear) yrbss_df[ , "t11l" ] <- c11l[ match( yrbss_df[ , "year" ] , seq( 1991 , 2011 , 2 ) ) ] # year^2 term (quadratic) yrbss_df[ , "t11q" ] <- c11q[ match( yrbss_df[ , "year" ] , seq( 1991 , 2011 , 2 ) ) ] # year^3 term (cubic) yrbss_df[ , "t11c" ] <- c11c[ match( yrbss_df[ , "year" ] , seq( 1991 , 2011 , 2 ) ) ] Unadjusted Analysis Examples Construct a complex sample survey design and match the published unadjusted prevalence rates: options( survey.lonely.psu = "adjust" ) library(survey) des <- svydesign( id = ~psu , strata = ~interaction( stratum , year ) , data = yrbss_df , weights = ~weight , nest = TRUE ) prevalence_over_time <- svyby( ~ ever_smoked , ~ year , des , svymean , na.rm = TRUE ) # confirm prevalence rates match published estimates # of high school students that ever smoked stopifnot( all.equal( round( coef( prevalence_over_time ) , 3 ) , c( .701 , .695 , .713 , .702 , .704 , .639 , .584 , .543 , .503 , .463 , .447 ) , check.attributes = FALSE ) ) Calculate Joinpoints Needed Using the orthogonal coefficients (linear, quadratic, cubic terms) that we previously added to our yrbss_df object before constructing the multi-year stacked survey design, determine how many joinpoints will be needed for a trend analysis. Epidemiological models typically control for possible confounding variables such as age, sex, and race/ethnicity, so those have been included alongside the linear, cubic, and quadratic year terms. Calculate the “ever smoked” regression, adjusted by sex, grade, race/ethnicity, and linear year contrast: linyear <- svyglm( ever_smoked ~ sex + race4 + grade + t11l , design = des , family = quasibinomial ) summary( linyear ) The linear year-contrast variable t11l is significant. Therefore, there is probably going to be some sort of trend. A linear trend by itself does not need joinpoints. Not one, just zero joinpoints. If the linear term were the only significant term (out of linear, quadratic, cubic), then we would not need to calculate a joinpoint. In other words, we would not need to figure out where to best break our time trend into two, three, or even four segments. Since the linear trend is significant, we know there is at least one change across the entire 1991 to 2011 period. Interpretation note about segments of time: The linear term t11l was significant, so we probably have a significant linear trend somewhere to report. Now we need to figure out when that significant linear trend started and when it ended. It might be semantically true that there was a significant linear decrease in high school aged smoking over the entire period of our data 1991-2011; however, it’s inexact to end this analysis after only detecting a linear trend. The purpose of the following few steps is to cordon off different time points from one another. As you’ll see later, there actually was not any detectable decrease from 1991-1999. The entirety of the decline in smoking occurred over the period from 1999-2011. So these next (methodologically tricky) steps serve to provide you and your audience with a more careful statement of statistical significance. It’s not technically wrong to conclude that smoking declined over the period of 1991-2011, it’s just verbose. Think of it as the difference between “humans first walked on the moon in the sixties” and “humans first walked on the moon in 1969” - both statements are correct, but the latter exhibits greater scientific precision. Calculate the “ever smoked” binomial regression, adjusted by sex, grade, race/ethnicity, and both linear and quadratic year contrasts. Notice the addition of t11q: quadyear <- svyglm( ever_smoked ~ sex + race4 + grade + t11l + t11q , design = des , family = quasibinomial ) summary( quadyear ) The linear year-contrast variable is significant but the quadratic year-contrast variable is also significant. Therefore, we should use joinpoint software (the segmented package) for this analysis. A significant quadratic trend needs one joinpoint. Since both linear and quadratic terms are significant, we can also move ahead and test whether the cubic term is also significant. Calculate the “ever smoked” binomial regression, adjusted by sex, grade, race/ethnicity, and linear, quadratic, and cubic year contrasts. Notice the addition of t11c: cubyear <- svyglm( ever_smoked ~ sex + race4 + grade + t11l + t11q + t11c , design = des , family = quasibinomial ) summary( cubyear ) The cubic year-contrast term is also significant in this model. Therefore, we might potentially evaluate this trend using two joinpoints. In other words, a significant result for all linear, quadratic, and cubic year contrasts at this point means we might be able to evaluate three distinct trends (separated by our two joinpoints) across the broader 1991 - 2011 time period of analysis. Although we might now have the statistical ability to analyze three distinct time periods (separated by two joinpoints) across our data, the utility of this depends on the circumstances. Cubic and higher polynomials account for not only the direction of change but also the pace of that change, allowing statistical statements that might not be of interest to an audience: While it might be an exercise in precision to conclude that smoking rates dropped quickest across 1999-2003 and less quickly across 2003-2011, that scientific pair of findings may not be as compelling as the simpler (quadratic but not cubic) statement that smoking rates have dropped across the period of 1999-2011. Calculate Predicted Marginals Calculate the survey-year-independent predictor effects and store these results: marginals <- svyglm( formula = ever_smoked ~ sex + race4 + grade , design = des , family = quasibinomial ) Run these marginals through the svypredmeans function. For archaeology fans out there, this function emulates the PREDMARG statement in the ancient language of SUDAAN: ( means_for_joinpoint <- svypredmeans( marginals , ~factor( year ) ) ) Clean up these results a bit in preparation for a joinpoint analysis: # coerce the results to a data.frame object means_for_joinpoint <- as.data.frame( means_for_joinpoint ) # extract the row names as the survey year means_for_joinpoint[ , "year" ] <- as.numeric( rownames( means_for_joinpoint ) ) # must be sorted, just in case it's not already means_for_joinpoint <- means_for_joinpoint[ order( means_for_joinpoint[ , "year" ] ) , ] Identify Joinpoint(s) or Breakpoint(s) Let’s take a look at how confident we are in the value at each adjusted timepoint. Carrying out a trend analysis requires creating new weights to fit a piecewise linear regression. First, create that weight variable: means_for_joinpoint[ , "wgt" ] <- with( means_for_joinpoint, ( mean / SE ) ^ 2 ) Second, fit a piecewise linear regression, estimating the ‘starting’ linear model with the usual lm function using the log values and the weights: o <- lm( log( mean ) ~ year , weights = wgt , data = means_for_joinpoint ) Now that the regression has been structured correctly, estimate the year that our complex survey trend should be broken into two or more segments: library(segmented) # find only one joinpoint os <- segmented( o , ~year ) summary( os ) Look for the Estimated Break-Point(s) in that result - that’s the critical number from this joinpoint analysis. The segmented package uses an iterative procedure (described in the article below); between-year solutions are returned and should be rounded to the nearest time point in the analysis. The joinpoint software implements two estimating algorithms: the grid-search and the Hudson algorithm. For more detail about these methods, see Muggeo V. (2003) Estimating regression models with unknown break-points. Statistics in Medicine, 22: 3055-3071.. Obtain the annual percent change estimates for each time point: slope( os , APC = TRUE ) The confidence intervals for the annual percent change (APC) may be different from the ones returned by NCI’s Joinpoint Software; for further details, check out Muggeo V. (2010) A Comment on `Estimating average annual per cent change in trend analysis’ by Clegg et al., Statistics in Medicine; 28, 3670-3682. Statistics in Medicine, 29, 1958-1960. This analysis returned similar results to the NCI’s Joinpoint Regression Program by estimating a joinpoint at year=1999 - and, more precisely, that the start of that decreasing trend in smoking prevalence happened at an APC of -3.92 percent. That is, slope2 from the output above. Remember that the cubic-year model above had significant terms as well. Therefore, it would be statistically defensible to calculate two joinpoints rather than only one. However, for this analyses, breaking the 1999-2011 trend into two separate downward trends might not be of interest to the audience. Looking at the slope2 and slope3 estimates and confidence intervals, we might be able to conclude that “ever smoking” decreased across 1999-2003 and also decreased (albeit less rapidly) across 2003-2011. However, communicating two consecutive downward trends might not be of much interest to a lay audience. Forgoing a second possible joinpoint makes sense when the direction of change is more compelling than the pace of change: # find two joinpoints rather than only one os2 <- segmented( o , ~year , npsi = 2 ) summary( os2 ) slope( os2 , APC = TRUE ) Interpret and Conclude After identifying the joinpoint for smoking prevalence, we can create two regression models (one for each time segment - if we had two joinpoints, we would need three regression models). The first model covers the years leading up to (and including) the joinpoint (i.e., 1991 to 1999). The second model includes the years from the joinpoint forward (i.e., 1999 to 2011). So start with 1991, 1993, 1995, 1997, 1999, the five year-points before (and including) 1999: # calculate a five-timepoint linear contrast vector c5l <- contr.poly( 5 )[ , 1 ] # tack the five-timepoint linear contrast vectors onto the current survey design object des <- update( des , t5l = c5l[ match( year , seq( 1991 , 1999 , 2 ) ) ] ) pre_91_99 <- svyglm( ever_smoked ~ sex + race4 + grade + t5l , design = subset( des , year <= 1999 ) , family = quasibinomial ) summary( pre_91_99 ) # confirm 1991-1999 trend coefficient matches published estimates stopifnot( round( pre_91_99$coefficients['t5l'] , 5 ) == .03704 ) This reproduces the calculations behind the sentence on pdf page 6 of the original document: In this example, T5L_L had a p-value=0.52261 and beta=0.03704. Therefore, there was “no significant change in the prevalence of ever smoking a cigarette during 1991-1999.” Then move on to 1999, 2001, 2003, 2005, 2007, 2009, and 2011, the seven year-points after (and including) 1999: # calculate a seven-timepoint linear contrast vector c7l <- contr.poly( 7 )[ , 1 ] # tack the seven-timepoint linear contrast vectors onto the current survey design object des <- update( des , t7l = c7l[ match( year , seq( 1999 , 2011 , 2 ) ) ] ) post_99_11 <- svyglm( ever_smoked ~ sex + race4 + grade + t7l , design = subset( des , year >= 1999 ) , family = quasibinomial ) summary( post_99_11 ) # confirm 1999-2011 trend coefficient matches published estimates stopifnot( round( post_99_11$coefficients['t7l'] , 5 ) == -0.99165 ) This reproduces the calculations behind the sentence on pdf page 6 of the original document: In this example, T7L_R had a p-value<0.0001 and beta=-0.99165. Therefore, there was a “significant linear decrease in the prevalence of ever smoking a cigarette during 1999-2011.” "],["american-community-survey-acs.html", "American Community Survey (ACS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " American Community Survey (ACS) The US Census Bureau’s annual replacement for the long-form decennial census. Two tables per state, the first with one row per household and the second with one row per individual. The civilian population of the United States. Released annually since 2005. Administered and financed by the US Census Bureau. Please skim before you begin: Guidance for Data Users Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # one percent sample # the decennial census # in miniature Download, Import, Preparation Download and import the Alabama household file: (switch sas_hal to sas_hak for Alaska or sas_hus for the entire country) library(haven) tf_household <- tempfile() this_url_household <- "https://www2.census.gov/programs-surveys/acs/data/pums/2021/1-Year/sas_hal.zip" download.file( this_url_household , tf_household , mode = 'wb' ) unzipped_files_household <- unzip( tf_household , exdir = tempdir() ) acs_sas_household <- grep( '\\\\.sas7bdat$' , unzipped_files_household , value = TRUE ) acs_df_household <- read_sas( acs_sas_household ) names( acs_df_household ) <- tolower( names( acs_df_household ) ) Download and import the Alabama person file: (switch sas_pal to sas_pak for Alaska or sas_pus for the entire country) tf_person <- tempfile() this_url_person <- "https://www2.census.gov/programs-surveys/acs/data/pums/2021/1-Year/sas_pal.zip" download.file( this_url_person , tf_person , mode = 'wb' ) unzipped_files_person <- unzip( tf_person , exdir = tempdir() ) acs_sas_person <- grep( '\\\\.sas7bdat$' , unzipped_files_person , value = TRUE ) acs_df_person <- read_sas( acs_sas_person ) names( acs_df_person ) <- tolower( names( acs_df_person ) ) Remove overlapping column and merge household + person files: acs_df_household[ , 'rt' ] <- NULL acs_df_person[ , 'rt' ] <- NULL acs_df <- merge( acs_df_household , acs_df_person ) stopifnot( nrow( acs_df ) == nrow( acs_df_person ) ) acs_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # acs_fn <- file.path( path.expand( "~" ) , "ACS" , "this_file.rds" ) # saveRDS( acs_df , file = acs_fn , compress = FALSE ) Load the same object: # acs_df <- readRDS( acs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) acs_design <- svrepdesign( weight = ~pwgtp , repweights = 'pwgtp[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = acs_df ) Variable Recoding Add new columns to the data set: acs_design <- update( acs_design , state_name = factor( as.numeric( st ) , levels = c(1L, 2L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 12L, 13L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 53L, 54L, 55L, 56L, 72L) , labels = c("Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "District of Columbia", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming", "Puerto Rico") ) , cit = factor( cit , levels = 1:5 , labels = c( 'born in the u.s.' , 'born in the territories' , 'born abroad to american parents' , 'naturalized citizen' , 'non-citizen' ) ) , poverty_level = as.numeric( povpip ) , married = as.numeric( mar %in% 1 ) , sex = factor( sex , labels = c( 'male' , 'female' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( acs_design , "sampling" ) != 0 ) svyby( ~ one , ~ cit , acs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , acs_design ) svyby( ~ one , ~ cit , acs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ poverty_level , acs_design , na.rm = TRUE ) svyby( ~ poverty_level , ~ cit , acs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ sex , acs_design ) svyby( ~ sex , ~ cit , acs_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ poverty_level , acs_design , na.rm = TRUE ) svyby( ~ poverty_level , ~ cit , acs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ sex , acs_design ) svyby( ~ sex , ~ cit , acs_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ poverty_level , acs_design , 0.5 , na.rm = TRUE ) svyby( ~ poverty_level , ~ cit , acs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ ssip , denominator = ~ pincp , acs_design , na.rm = TRUE ) Subsetting Restrict the survey design to senior citizens: sub_acs_design <- subset( acs_design , agep >= 65 ) Calculate the mean (average) of this subset: svymean( ~ poverty_level , sub_acs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ poverty_level , acs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ poverty_level , ~ cit , acs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( acs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ poverty_level , acs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ poverty_level , acs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ poverty_level , acs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ married , acs_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( poverty_level ~ married , acs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ married + sex , acs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( poverty_level ~ married + sex , acs_design ) summary( glm_result ) Replication Example This example matches statistics, standard errors, and margin of errors from the 2021 PUMS tallies: Match the sum of the weights: stopifnot( round( coef( svytotal( ~ one , acs_design ) ) , 0 ) == 5039877 ) Compute the population by age: pums_estimate <- c(288139L, 299245L, 336727L, 334606L, 327102L, 635004L, 641405L, 615709L, 335431L, 341926L, 538367L, 265742L, 80474L) pums_standard_error <- c(2727L, 5368L, 6067L, 4082L, 4485L, 5716L, 4420L, 3706L, 4836L, 5100L, 2158L, 3363L, 3186L) pums_margin_of_error <- c(4486L, 8830L, 9981L, 6715L, 7378L, 9402L, 7271L, 6096L, 7956L, 8389L, 3550L, 5532L, 5240L) results <- svytotal( ~ as.numeric( agep %in% 0:4 ) + as.numeric( agep %in% 5:9 ) + as.numeric( agep %in% 10:14 ) + as.numeric( agep %in% 15:19 ) + as.numeric( agep %in% 20:24 ) + as.numeric( agep %in% 25:34 ) + as.numeric( agep %in% 35:44 ) + as.numeric( agep %in% 45:54 ) + as.numeric( agep %in% 55:59 ) + as.numeric( agep %in% 60:64 ) + as.numeric( agep %in% 65:74 ) + as.numeric( agep %in% 75:84 ) + as.numeric( agep %in% 85:100 ) , acs_design ) stopifnot( all( round( coef( results ) , 0 ) == pums_estimate ) ) stopifnot( all( round( SE( results ) , 0 ) == pums_standard_error ) ) stopifnot( all( round( SE( results ) * 1.645 , 0 ) == pums_margin_of_error ) ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for ACS users, this code calculates the gini coefficient on complex sample survey data: library(convey) acs_design <- convey_prep( acs_design ) svygini( ~ hincp , acs_design , na.rm = TRUE ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for ACS users, this code replicates previously-presented examples: library(srvyr) acs_srvyr_design <- as_survey( acs_design ) Calculate the mean (average) of a linear variable, overall and by groups: acs_srvyr_design %>% summarize( mean = survey_mean( poverty_level , na.rm = TRUE ) ) acs_srvyr_design %>% group_by( cit ) %>% summarize( mean = survey_mean( poverty_level , na.rm = TRUE ) ) "],["area-health-resources-files-ahrf.html", "Area Health Resources Files (AHRF) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Area Health Resources Files (AHRF) National, state, and county-level data on health care professions, health facilities, population characteristics, health workforce training, hospital utilization and expenditure, and the environment. One table with one row per county and a second table with one row per state. Replaced annually with the latest available county- and state-level statistics. Compiled by the Bureau of Health Workforce at the Health Services and Resources Administration. Please skim before you begin: User Documentation for the County Area Health Resources File (AHRF) 2021-2022 Release Frequently Asked Questions This human-composed haiku or a bouquet of artificial intelligence-generated limericks # local aggregates # to spread merge join spline regress # like fresh buttered bread Download, Import, Preparation Download and import the most current county-level file: library(haven) tf <- tempfile() ahrf_url <- "https://data.hrsa.gov//DataDownload/AHRF/AHRF_2021-2022_SAS.zip" download.file( ahrf_url , tf , mode = 'wb' ) unzipped_files <- unzip( tf , exdir = tempdir() ) sas_fn <- grep( "\\\\.sas7bdat$" , unzipped_files , value = TRUE ) ahrf_tbl <- read_sas( sas_fn ) ahrf_df <- data.frame( ahrf_tbl ) names( ahrf_df ) <- tolower( names( ahrf_df ) ) Save locally   Save the object at any point: # ahrf_fn <- file.path( path.expand( "~" ) , "AHRF" , "this_file.rds" ) # saveRDS( ahrf_df , file = ahrf_fn , compress = FALSE ) Load the same object: # ahrf_df <- readRDS( ahrf_fn ) Variable Recoding Add new columns to the data set: ahrf_df <- transform( ahrf_df , cbsa_indicator_code = factor( as.numeric( f1406720 ) , levels = 0:2 , labels = c( "not metro" , "metro" , "micro" ) ) , mhi_2020 = f1322620 , whole_county_hpsa_2022 = as.numeric( f0978722 ) == 1 , census_region = factor( as.numeric( f04439 ) , levels = 1:4 , labels = c( "northeast" , "midwest" , "south" , "west" ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( ahrf_df ) table( ahrf_df[ , "cbsa_indicator_code" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( ahrf_df[ , "mhi_2020" ] , na.rm = TRUE ) tapply( ahrf_df[ , "mhi_2020" ] , ahrf_df[ , "cbsa_indicator_code" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( ahrf_df[ , "census_region" ] ) ) prop.table( table( ahrf_df[ , c( "census_region" , "cbsa_indicator_code" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( ahrf_df[ , "mhi_2020" ] , na.rm = TRUE ) tapply( ahrf_df[ , "mhi_2020" ] , ahrf_df[ , "cbsa_indicator_code" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( ahrf_df[ , "mhi_2020" ] , 0.5 , na.rm = TRUE ) tapply( ahrf_df[ , "mhi_2020" ] , ahrf_df[ , "cbsa_indicator_code" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to California: sub_ahrf_df <- subset( ahrf_df , f12424 == "CA" ) Calculate the mean (average) of this subset: mean( sub_ahrf_df[ , "mhi_2020" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( ahrf_df[ , "mhi_2020" ] , na.rm = TRUE ) tapply( ahrf_df[ , "mhi_2020" ] , ahrf_df[ , "cbsa_indicator_code" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( mhi_2020 ~ whole_county_hpsa_2022 , ahrf_df ) Perform a chi-squared test of association: this_table <- table( ahrf_df[ , c( "whole_county_hpsa_2022" , "census_region" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( mhi_2020 ~ whole_county_hpsa_2022 + census_region , data = ahrf_df ) summary( glm_result ) Replication Example Match the record count in row number 8,543 of AHRF 2021-2022 Technical Documentation.xlsx: stopifnot( nrow( ahrf_df ) == 3232 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for AHRF users, this code replicates previously-presented examples: library(dplyr) ahrf_tbl <- as_tibble( ahrf_df ) Calculate the mean (average) of a linear variable, overall and by groups: ahrf_tbl %>% summarize( mean = mean( mhi_2020 , na.rm = TRUE ) ) ahrf_tbl %>% group_by( cbsa_indicator_code ) %>% summarize( mean = mean( mhi_2020 , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for AHRF users, this code replicates previously-presented examples: library(data.table) ahrf_dt <- data.table( ahrf_df ) Calculate the mean (average) of a linear variable, overall and by groups: ahrf_dt[ , mean( mhi_2020 , na.rm = TRUE ) ] ahrf_dt[ , mean( mhi_2020 , na.rm = TRUE ) , by = cbsa_indicator_code ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for AHRF users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'ahrf' , ahrf_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( mhi_2020 ) FROM ahrf' ) dbGetQuery( con , 'SELECT cbsa_indicator_code , AVG( mhi_2020 ) FROM ahrf GROUP BY cbsa_indicator_code' ) "],["american-housing-survey-ahs.html", "American Housing Survey (AHS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " American Housing Survey (AHS) The nationwide assessment of housing stock, with information on physical condition and neighborhood, costs of financing and maintenance, owner and renter characteristics, and changes over time. Nationally-representative and metropolitan flat files with one row per household, plus relational files. A complex sample survey of occupied and vacant housing units designed to generalize to all structures in the United States, both nationally and also for about thirty-five metropolitan areas. Released more or less biennially since 1973, with longitudinal samples redrawn in 1985 and 2015. Sponsored by the Department of Housing and Urban Development, run by the Census Bureau. Please skim before you begin: Getting Started with the Public Use File: 2015 and Beyond Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # real estate supply # half bath addition, raised roof # vent, rent too damn high Download, Import, Preparation Download and import the national 2021 flat file: library(haven) library(httr) tf <- tempfile() this_url <- paste0( "https://www2.census.gov/programs-surveys/ahs/" , "2021/AHS%202021%20National%20PUF%20v1.0%20Flat%20SAS.zip" ) GET( this_url , write_disk( tf ) , progress() ) ahs_tbl <- read_sas( tf ) ahs_df <- data.frame( ahs_tbl ) names( ahs_df ) <- tolower( names( ahs_df ) ) Save locally   Save the object at any point: # ahs_fn <- file.path( path.expand( "~" ) , "AHS" , "this_file.rds" ) # saveRDS( ahs_df , file = ahs_fn , compress = FALSE ) Load the same object: # ahs_df <- readRDS( ahs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) ahs_design <- svrepdesign( weights = ~ weight , repweights = "repweight[1-9]" , type = "Fay" , rho = ( 1 - 1 / sqrt( 4 ) ) , mse = TRUE , data = ahs_df ) Variable Recoding Add new columns to the data set: ahs_design <- update( ahs_design , one = 1 , tenure = factor( ifelse( tenure %in% c( -6 , 'N' ) , 4 , tenure ) , levels = 1:4 , labels = c( 'Owned or being bought' , 'Rented for cash rent' , 'Occupied without payment of cash rent' , 'Not occupied' ) ) , lotsize = factor( lotsize , levels = 1:7 , labels = c( "Less then 1/8 acre" , "1/8 up to 1/4 acre" , "1/4 up to 1/2 acre" , "1/2 up to 1 acre" , "1 up to 5 acres" , "5 up to 10 acres" , "10 acres or more" ) ) , below_poverty = as.numeric( perpovlvl < 100 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( ahs_design , "sampling" ) != 0 ) svyby( ~ one , ~ tenure , ahs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , ahs_design ) svyby( ~ one , ~ tenure , ahs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ totrooms , ahs_design , na.rm = TRUE ) svyby( ~ totrooms , ~ tenure , ahs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ lotsize , ahs_design , na.rm = TRUE ) svyby( ~ lotsize , ~ tenure , ahs_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ totrooms , ahs_design , na.rm = TRUE ) svyby( ~ totrooms , ~ tenure , ahs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ lotsize , ahs_design , na.rm = TRUE ) svyby( ~ lotsize , ~ tenure , ahs_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ totrooms , ahs_design , 0.5 , na.rm = TRUE ) svyby( ~ totrooms , ~ tenure , ahs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ totrooms , denominator = ~ rent , ahs_design , na.rm = TRUE ) Subsetting Restrict the survey design to homes with a garage or carport: sub_ahs_design <- subset( ahs_design , garage == 1 ) Calculate the mean (average) of this subset: svymean( ~ totrooms , sub_ahs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ totrooms , ahs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ totrooms , ~ tenure , ahs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( ahs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ totrooms , ahs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ totrooms , ahs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ totrooms , ahs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ below_poverty , ahs_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( totrooms ~ below_poverty , ahs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ below_poverty + lotsize , ahs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( totrooms ~ below_poverty + lotsize , ahs_design ) summary( glm_result ) Replication Example This example matches the estimate and margin of error of the Total row of the General Housing tab from the AHS 2021 Table Specifications and PUF Estimates for User Verification: result <- svytotal( ~ as.numeric( intstatus == 1 ) , ahs_design ) stopifnot( round( coef( result ) / 1000 , 0 ) == 128504 ) ci_results <- confint( result , level = 0.9 ) stopifnot( round( ( ci_results[ 2 ] - coef( result ) ) / 1000 , 0 ) == 388 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for AHS users, this code replicates previously-presented examples: library(srvyr) ahs_srvyr_design <- as_survey( ahs_design ) Calculate the mean (average) of a linear variable, overall and by groups: ahs_srvyr_design %>% summarize( mean = survey_mean( totrooms , na.rm = TRUE ) ) ahs_srvyr_design %>% group_by( tenure ) %>% summarize( mean = survey_mean( totrooms , na.rm = TRUE ) ) "],["american-national-election-studies-anes.html", "American National Election Studies (ANES) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " American National Election Studies (ANES) A time series recording belief, public opinion, and political participation back to Dewey vs. Truman. Most tables contain one row per sampled eligible voter, varying weights like pre- and post-election. A complex sample generalizing to eligible voters in the U.S. with some panels to follow individuals. Core studies released quadrennially (presidential elections), plus pilot studies (often at midterms). Administered by a consortium of universities and funded by the National Science Foundation. Please skim before you begin: ANES 2020 Time Series Study Full Release: User Guide and Codebook How to Analyze ANES Survey Data This human-composed haiku or a bouquet of artificial intelligence-generated limericks # chez sacrificed queen # quadrennial bloodless coup # knight churchill's least worst Download, Import, Preparation Define a function to import a stata file as a data.frame: library(haven) anes_import_dta <- function( this_fn ){ this_tbl <- read_dta( this_fn ) this_tbl <- zap_labels( this_tbl ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) this_df } Register for the ANES Data Center at https://electionstudies.org/ Choose 2020 Time Series Study Download the STATA version of the February 10, 2022 file: library(haven) anes_fn <- file.path( path.expand( "~" ) , "anes_timeseries_2020_stata_20220210.dta" ) anes_df <- anes_import_dta( anes_fn ) Save locally   Save the object at any point: # anes_fn <- file.path( path.expand( "~" ) , "ANES" , "this_file.rds" ) # saveRDS( anes_df , file = anes_fn , compress = FALSE ) Load the same object: # anes_df <- readRDS( anes_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) anes_design <- svydesign( ids = ~ v200010c , strata = ~ v200010d , weights = ~ v200010a , data = subset( anes_df , v200010a > 0 ) , nest = TRUE ) Variable Recoding Add new columns to the data set: anes_design <- update( anes_design , one = 1 , democratic_party_rating = ifelse( v201156 %in% 0:100 , v201156 , NA ) , republican_party_rating = ifelse( v201157 %in% 0:100 , v201157 , NA ) , primary_voter = ifelse( v201020 %in% 1:2 , as.numeric( v201020 == 1 ) , NA ) , think_gov_spend_least = factor( v201645 , levels = 1:4 , labels = c( 'foreign aid (correct)' , 'medicare' , 'national defense' , 'social security' ) ) , undoc_kids = factor( v201423x , levels = 1:6 , labels = c( 'should sent back - favor a great deal' , 'should sent back - favor a moderate amount' , 'should sent back - favor a little' , 'should allow to stay - favor a little' , 'should allow to stay - favor a moderate amount' , 'should allow to stay - favor a great deal' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( anes_design , "sampling" ) != 0 ) svyby( ~ one , ~ undoc_kids , anes_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , anes_design ) svyby( ~ one , ~ undoc_kids , anes_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ republican_party_rating , anes_design , na.rm = TRUE ) svyby( ~ republican_party_rating , ~ undoc_kids , anes_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ think_gov_spend_least , anes_design , na.rm = TRUE ) svyby( ~ think_gov_spend_least , ~ undoc_kids , anes_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ republican_party_rating , anes_design , na.rm = TRUE ) svyby( ~ republican_party_rating , ~ undoc_kids , anes_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ think_gov_spend_least , anes_design , na.rm = TRUE ) svyby( ~ think_gov_spend_least , ~ undoc_kids , anes_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ republican_party_rating , anes_design , 0.5 , na.rm = TRUE ) svyby( ~ republican_party_rating , ~ undoc_kids , anes_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ republican_party_rating , denominator = ~ democratic_party_rating , anes_design , na.rm = TRUE ) Subsetting Restrict the survey design to party id: independent: sub_anes_design <- subset( anes_design , v201231x == 4 ) Calculate the mean (average) of this subset: svymean( ~ republican_party_rating , sub_anes_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ republican_party_rating , anes_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ republican_party_rating , ~ undoc_kids , anes_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( anes_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ republican_party_rating , anes_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ republican_party_rating , anes_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ republican_party_rating , anes_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ primary_voter , anes_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( republican_party_rating ~ primary_voter , anes_design ) Perform a chi-squared test of association for survey data: svychisq( ~ primary_voter + think_gov_spend_least , anes_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( republican_party_rating ~ primary_voter + think_gov_spend_least , anes_design ) summary( glm_result ) Replication Example This example matches statistics and standard errors in the Age rows of the ANES respondents (weighted) column of Table 1A from Benchmark and Attrition Report for the ANES 2016 Time Series Study: Log in to the ANES Data Center at https://electionstudies.org/ Choose 2016 Time Series Study. Download the DTA version of the September 4, 2019 file Download the DTA version of the Methodology File December 10, 2018 anes2016_fn <- file.path( path.expand( "~" ) , "anes_timeseries_2016.dta" ) anes2016_df <- anes_import_dta( anes2016_fn ) method2016_fn <- file.path( path.expand( "~" ) , "anes_timeseries_2016_methodology_dta.dta" ) method2016_df <- anes_import_dta( method2016_fn ) before_nrow <- nrow( anes2016_df ) anes2016_df <- merge( anes2016_df , method2016_df , by = 'v160001' ) stopifnot( nrow( anes2016_df ) == before_nrow ) anes2016_df[ , 'age_categories' ] <- factor( findInterval( anes2016_df[ , 'v161267' ] , c( 18 , seq( 30 , 70 , 10 ) ) ) , levels = 1:6 , labels = c( '18-29' , '30-39' , '40-49' , '50-59' , '60-69' , '70 or older' ) ) anes2016_design <- svrepdesign( data = subset( anes2016_df , v160101f > 0 ) , weights = ~ v160101f , repweights = 'weight_ftf_rkwt([0-9]+)' , type = 'JK1' , scale = 32 / 33 ) ( results <- svymean( ~ age_categories , anes2016_design , na.rm = TRUE ) ) published_results <- c( 0.21 , 0.158 , 0.156 , 0.2 , 0.147 , 0.129 ) published_standard_errors <- c( 0.0091 , 0.009 , 0.0094 , 0.0122 , 0.0069 , 0.0083 ) stopifnot( all( round( coef( results ) , 3 ) == published_results ) ) stopifnot( all( round( SE( results ) , 4 ) == published_standard_errors ) ) This example matches statistics and standard errors in the Age rows of the Design-consistent, with published strata column of Table 1 from How to Analyze ANES Survey Data: Log in to the ANES Data Center at https://electionstudies.org/ Choose 2004 Time Series Study4 Download the DTA version of the Full Release August 16, 2005 file Choose 2006 Pilot Study Download the DTA version of the April 26, 2007 file anes2004_fn <- file.path( path.expand( "~" ) , "anes2004TS.dta" ) anes2004_df <- anes_import_dta( anes2004_fn ) pilot2006_fn <- file.path( path.expand( "~" ) , "anes2006pilot.dta" ) pilot2006_df <- anes_import_dta( pilot2006_fn ) before_nrow <- nrow( pilot2006_df ) pilot2006_df <- merge( pilot2006_df , anes2004_df , by.x = 'v06p001' , by.y = 'v040001' ) stopifnot( nrow( pilot2006_df ) == before_nrow ) pilot2006_df[ , 'age_categories' ] <- factor( findInterval( pilot2006_df[ , 'v043250' ] , c( 18 , seq( 30 , 70 , 10 ) ) ) , levels = 1:6 , labels = c( '18-29' , '30-39' , '40-49' , '50-59' , '60-69' , '70 or older' ) ) pilot2006_design <- svydesign( id = ~v06p007b , strata = ~v06p007a , data = pilot2006_df , weights = ~v06p002 , nest = TRUE ) ( results <- svymean( ~ age_categories , pilot2006_design , na.rm = TRUE ) ) published_results <- c( 0.207 , 0.162 , 0.218 , 0.175 , 0.111 , 0.126 ) published_standard_errors <- c( 0.0251 , 0.024 , 0.022 , 0.0149 , 0.0125 , 0.0287 ) stopifnot( all( round( coef( results ) , 3 ) == published_results ) ) stopifnot( all( round( SE( results ) , 4 ) == published_standard_errors ) ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for ANES users, this code replicates previously-presented examples: library(srvyr) anes_srvyr_design <- as_survey( anes_design ) Calculate the mean (average) of a linear variable, overall and by groups: anes_srvyr_design %>% summarize( mean = survey_mean( republican_party_rating , na.rm = TRUE ) ) anes_srvyr_design %>% group_by( undoc_kids ) %>% summarize( mean = survey_mean( republican_party_rating , na.rm = TRUE ) ) "],["american-time-use-survey-atus.html", "American Time Use Survey (ATUS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " American Time Use Survey (ATUS) Sampled individuals write down everything they do for a single twenty-four hour period, in ten minute intervals. Time use data allows for the study of uncompensated work like cooking, chores, childcare. Many tables with structures described in the user guide, linkable to the Current Population Survey. A complex survey generalizing to person-hours among civilian non-institutional americans aged 15+. Released annually since 2003. Administered by the Bureau of Labor Statistics. Please skim before you begin: American Time Use Survey User’s Guide Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # don't judge me bruno # eat one hour, sleep the rest # it's my lazy day Download, Import, Preparation Define a function to download, unzip, and import each comma-separated value dat file: library(httr) atus_csv_import <- function( this_url ){ this_tf <- tempfile() this_dl <- GET( this_url , user_agent( "email@address.com") ) writeBin( content( this_dl ) , this_tf ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) this_dat <- grep( '\\\\.dat$' , unzipped_files , value = TRUE ) this_df <- read.csv( this_dat ) file.remove( c( this_tf , unzipped_files ) ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the activity, respondent, roster, and weights tables: act_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusact-2021.zip" ) resp_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusresp-2021.zip" ) rost_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusrost-2021.zip" ) wgts_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atuswgts-2021.zip" ) Specify which variables to keep in each of the data.frame objects: act_df <- act_df[ c( 'tucaseid' , 'tutier1code' , 'tutier2code' , 'tuactdur24' ) ] resp_df <- resp_df[ c( 'tucaseid' , 'tufinlwgt' , 'tulineno' ) ] rost_df <- rost_df[ , c( 'tucaseid' , 'tulineno' , 'teage' , 'tesex' ) ] Distribute travel-related activities (tutier1code == 18 from the lexicon) based on their second tier code: act_df[ act_df[ , 'tutier1code' ] == 18 & act_df[ , 'tutier2code' ] == 99 , 'tutier1code' ] <- 50 act_df[ act_df[ , 'tutier1code' ] == 18 , 'tutier1code' ] <- act_df[ act_df[ , 'tutier1code' ] == 18 , 'tutier2code' ] Sum up all durations at the (respondent x major activity category)-level: act_long_df <- aggregate( tuactdur24 ~ tucaseid + tutier1code , data = act_df , sum ) act_wide_df <- reshape( act_long_df , idvar = 'tucaseid' , timevar = 'tutier1code' , direction = 'wide' ) # for individuals not engaging in an activity category, replace missings with zero minutes act_wide_df[ is.na( act_wide_df ) ] <- 0 # for all columns except the respondent identifier, convert minutes to hours act_wide_df[ , -1 ] <- act_wide_df[ , -1 ] / 60 Merge the respondent and summed activity tables, then the roster table, and finally the replicate weights: resp_act_df <- merge( resp_df , act_wide_df ) stopifnot( nrow( resp_act_df ) == nrow( resp_df ) ) resp_act_rost_df <- merge( resp_act_df , rost_df ) stopifnot( nrow( resp_act_rost_df ) == nrow( resp_df ) ) atus_df <- merge( resp_act_rost_df , wgts_df ) stopifnot( nrow( atus_df ) == nrow( resp_df ) ) # remove dots from column names names( atus_df ) <- gsub( "\\\\." , "_" , names( atus_df ) ) atus_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # atus_fn <- file.path( path.expand( "~" ) , "ATUS" , "this_file.rds" ) # saveRDS( atus_df , file = atus_fn , compress = FALSE ) Load the same object: # atus_df <- readRDS( atus_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) atus_design <- svrepdesign( weights = ~ tufinlwgt , repweights = "finlwgt[0-9]" , type = "Fay" , rho = ( 1 - 1 / sqrt( 4 ) ) , mse = TRUE , data = atus_df ) Variable Recoding Add new columns to the data set: # caring for and helping household members is top level 03 from the lexicon # https://www.bls.gov/tus/lexicons/lexiconnoex2021.pdf atus_design <- update( atus_design , any_care = as.numeric( tuactdur24_3 > 0 ) , tesex = factor( tesex , levels = 1:2 , labels = c( 'male' , 'female' ) ) , age_category = factor( 1 + findInterval( teage , c( 18 , 35 , 65 ) ) , labels = c( "under 18" , "18 - 34" , "35 - 64" , "65 or older" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( atus_design , "sampling" ) != 0 ) svyby( ~ one , ~ age_category , atus_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , atus_design ) svyby( ~ one , ~ age_category , atus_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ tuactdur24_1 , atus_design ) svyby( ~ tuactdur24_1 , ~ age_category , atus_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ tesex , atus_design ) svyby( ~ tesex , ~ age_category , atus_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ tuactdur24_1 , atus_design ) svyby( ~ tuactdur24_1 , ~ age_category , atus_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ tesex , atus_design ) svyby( ~ tesex , ~ age_category , atus_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ tuactdur24_1 , atus_design , 0.5 ) svyby( ~ tuactdur24_1 , ~ age_category , atus_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ tuactdur24_5 , denominator = ~ tuactdur24_12 , atus_design ) Subsetting Restrict the survey design to any time volunteering: sub_atus_design <- subset( atus_design , tuactdur24_15 > 0 ) Calculate the mean (average) of this subset: svymean( ~ tuactdur24_1 , sub_atus_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ tuactdur24_1 , atus_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ tuactdur24_1 , ~ age_category , atus_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( atus_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ tuactdur24_1 , atus_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ tuactdur24_1 , atus_design , deff = TRUE ) # SRS with replacement svymean( ~ tuactdur24_1 , atus_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ any_care , atus_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( tuactdur24_1 ~ any_care , atus_design ) Perform a chi-squared test of association for survey data: svychisq( ~ any_care + tesex , atus_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( tuactdur24_1 ~ any_care + tesex , atus_design ) summary( glm_result ) Replication Example This example matches the “Caring for and helping household members” row of Table A-1: hours_per_day_civilian_population <- svymean( ~ tuactdur24_3 , atus_design ) stopifnot( round( coef( hours_per_day_civilian_population ) , 2 ) == 0.47 ) percent_engaged_per_day <- svymean( ~ any_care , atus_design ) stopifnot( round( coef( percent_engaged_per_day ) , 3 ) == 0.217 ) hours_per_day_among_engaged <- svymean( ~ tuactdur24_3 , subset( atus_design , any_care ) ) stopifnot( round( coef( hours_per_day_among_engaged ) , 2 ) == 2.17 ) This example matches the average hours and SE from Section 7.5 of the User’s Guide: Download and import the activity, activity summary, respondent, and weights tables: actsum07_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atussum_2007.zip" ) resp07_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusresp_2007.zip" ) act07_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusact_2007.zip" ) wgts07_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atuswgts_2007.zip" ) Option 1. Sum the two television fields from the activity summary file, removing zeroes: television_per_person <- data.frame( tucaseid = actsum07_df[ , 'tucaseid' ] , tuactdur24 = rowSums( actsum07_df[ , c( 't120303' , 't120304' ) ] ) ) television_per_person <- television_per_person[ television_per_person[ , 'tuactdur24' ] > 0 , ] Option 2. Limit the activity file to television watching records according to the 2007 Lexicon: television_activity <- subset( act07_df , tutier1code == 12 & tutier2code == 3 & tutier3code %in% 3:4 ) television_activity_summed <- aggregate( tuactdur24 ~ tucaseid , data = television_activity , sum ) Confirm both aggregation options yield the same results: stopifnot( all( television_per_person[ , 'tucaseid' ] == television_activity_summed[ , 'tucaseid' ] ) ) stopifnot( all( television_per_person[ , 'tuactdur24' ] == television_activity_summed[ , 'tuactdur24' ] ) ) Merge the respondent and summed activity tables, then the replicate weights: resp07_tpp_df <- merge( resp07_df[ , c( 'tucaseid' , 'tufinlwgt' ) ] , television_per_person , all.x = TRUE ) stopifnot( nrow( resp07_tpp_df ) == nrow( resp07_df ) ) # for individuals without television time, replace missings with zero minutes resp07_tpp_df[ is.na( resp07_tpp_df[ , 'tuactdur24' ] ) , 'tuactdur24' ] <- 0 # convert minutes to hours resp07_tpp_df[ , 'tuactdur24_hour' ] <- resp07_tpp_df[ , 'tuactdur24' ] / 60 atus07_df <- merge( resp07_tpp_df , wgts07_df ) stopifnot( nrow( atus07_df ) == nrow( resp07_df ) ) Construct a complex sample survey design: atus07_design <- svrepdesign( weights = ~ tufinlwgt , repweights = "finlwgt[0-9]" , type = "Fay" , rho = ( 1 - 1 / sqrt( 4 ) ) , data = atus07_df ) Match the statistic and SE of the number of hours daily that americans older than 14 watch tv: result <- svymean( ~ tuactdur24_hour , atus07_design ) stopifnot( round( coef( result ) , 2 ) == 2.62 ) stopifnot( round( SE( result ) , 4 ) == 0.0293 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for ATUS users, this code replicates previously-presented examples: library(srvyr) atus_srvyr_design <- as_survey( atus_design ) Calculate the mean (average) of a linear variable, overall and by groups: atus_srvyr_design %>% summarize( mean = survey_mean( tuactdur24_1 ) ) atus_srvyr_design %>% group_by( age_category ) %>% summarize( mean = survey_mean( tuactdur24_1 ) ) "],["behavioral-risk-factor-surveillance-system-brfss.html", "Behavioral Risk Factor Surveillance System (BRFSS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Behavioral Risk Factor Surveillance System (BRFSS) A health behavior telephone interview survey with enough sample size to examine all fifty states. One table with one row per telephone respondent. A complex survey designed to generalize to the civilian non-institutional adult population of the U.S. Released annually since 1984 but all states did not participate until 1994. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: BRFSS Data User Guide Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # a cellphone vibrates # it's the cdc! asking # if you ate veggies Download, Import, Preparation Download and import the national file: library(haven) zip_tf <- tempfile() zip_url <- "https://www.cdc.gov/brfss/annual_data/2021/files/LLCP2021XPT.zip" download.file( zip_url , zip_tf , mode = 'wb' ) brfss_tbl <- read_xpt( zip_tf ) brfss_df <- data.frame( brfss_tbl ) names( brfss_df ) <- tolower( names( brfss_df ) ) brfss_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # brfss_fn <- file.path( path.expand( "~" ) , "BRFSS" , "this_file.rds" ) # saveRDS( brfss_df , file = brfss_fn , compress = FALSE ) Load the same object: # brfss_df <- readRDS( brfss_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) variables_to_keep <- c( 'one' , 'x_psu' , 'x_ststr' , 'x_llcpwt' , 'genhlth' , 'medcost1' , 'x_state' , 'x_age80' , 'nummen' , 'numadult' , 'x_hlthpln' ) brfss_df <- brfss_df[ variables_to_keep ] brfss_national_design <- svydesign( id = ~ x_psu , strata = ~ x_ststr , data = brfss_df , weight = ~ x_llcpwt , nest = TRUE ) Since large linearized survey designs execute slowly, a replication design might be preferrable for exploratory analysis. Coefficients (such as means and medians) do not change, standard errors and confidence intervals differ slightly. The initial conversion with as.svrepdesign requires an extended period of processing time (perhaps run once overnight), subsequent analyses will finish much faster: # brfss_replication_design <- # as.svrepdesign( # brfss_national_design , # type = 'bootstrap' # ) # system.time( print( svymean( ~ x_age80 , brfss_national_design ) ) ) # system.time( print( svymean( ~ x_age80 , brfss_replication_design ) ) ) In this example, limit the national design to only Alaska for quicker processing: brfss_design <- subset( brfss_national_design , x_state %in% 2 ) Variable Recoding Add new columns to the data set: brfss_design <- update( brfss_design , fair_or_poor_health = ifelse( genhlth %in% 1:5 , as.numeric( genhlth > 3 ) , NA ) , no_doc_visit_due_to_cost = factor( medcost1 , levels = c( 1 , 2 , 7 , 9 ) , labels = c( "yes" , "no" , "dk" , "rf" ) ) , state_name = factor( x_state , levels = c(1, 2, 4, 5, 6, 8, 9, 10, 11, 12, 13, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 44, 45, 46, 47, 48, 49, 50, 51, 53, 54, 55, 56, 66, 72, 78) , labels = c("ALABAMA", "ALASKA", "ARIZONA", "ARKANSAS", "CALIFORNIA", "COLORADO", "CONNECTICUT", "DELAWARE", "DISTRICT OF COLUMBIA", "FLORIDA", "GEORGIA", "HAWAII", "IDAHO", "ILLINOIS", "INDIANA", "IOWA", "KANSAS", "KENTUCKY", "LOUISIANA", "MAINE", "MARYLAND", "MASSACHUSETTS", "MICHIGAN", "MINNESOTA", "MISSISSIPPI", "MISSOURI", "MONTANA", "NEBRASKA", "NEVADA", "NEW HAMPSHIRE", "NEW JERSEY", "NEW MEXICO", "NEW YORK", "NORTH CAROLINA", "NORTH DAKOTA", "OHIO", "OKLAHOMA", "OREGON", "PENNSYLVANIA", "RHODE ISLAND", "SOUTH CAROLINA", "SOUTH DAKOTA", "TENNESSEE", "TEXAS", "UTAH", "VERMONT", "VIRGINIA", "WASHINGTON", "WEST VIRGINIA", "WISCONSIN", "WYOMING", "GUAM", "PUERTO RICO", "U.S. VIRGIN ISLANDS") ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( brfss_design , "sampling" ) != 0 ) svyby( ~ one , ~ state_name , brfss_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , brfss_design ) svyby( ~ one , ~ state_name , brfss_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ x_age80 , brfss_design ) svyby( ~ x_age80 , ~ state_name , brfss_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ no_doc_visit_due_to_cost , brfss_design , na.rm = TRUE ) svyby( ~ no_doc_visit_due_to_cost , ~ state_name , brfss_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ x_age80 , brfss_design ) svyby( ~ x_age80 , ~ state_name , brfss_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ no_doc_visit_due_to_cost , brfss_design , na.rm = TRUE ) svyby( ~ no_doc_visit_due_to_cost , ~ state_name , brfss_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ x_age80 , brfss_design , 0.5 ) svyby( ~ x_age80 , ~ state_name , brfss_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ nummen , denominator = ~ numadult , brfss_design , na.rm = TRUE ) Subsetting Restrict the survey design to persons without health insurance: sub_brfss_design <- subset( brfss_design , x_hlthpln == 2 ) Calculate the mean (average) of this subset: svymean( ~ x_age80 , sub_brfss_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ x_age80 , brfss_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ x_age80 , ~ state_name , brfss_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( brfss_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ x_age80 , brfss_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ x_age80 , brfss_design , deff = TRUE ) # SRS with replacement svymean( ~ x_age80 , brfss_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ fair_or_poor_health , brfss_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( x_age80 ~ fair_or_poor_health , brfss_design ) Perform a chi-squared test of association for survey data: svychisq( ~ fair_or_poor_health + no_doc_visit_due_to_cost , brfss_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( x_age80 ~ fair_or_poor_health + no_doc_visit_due_to_cost , brfss_design ) summary( glm_result ) Replication Example This example matches Alaska’s confidence intervals from the BRFSS Prevalence & Trends Data: result <- svymean( ~ no_doc_visit_due_to_cost , subset( brfss_design , no_doc_visit_due_to_cost %in% c( 'yes' , 'no' ) ) , na.rm = TRUE ) stopifnot( round( confint( result )[ 1 , 1 ] , 3 ) == 0.094 ) stopifnot( round( confint( result )[ 1 , 2 ] , 3 ) == 0.122 ) stopifnot( round( confint( result )[ 2 , 1 ] , 3 ) == 0.878 ) stopifnot( round( confint( result )[ 2 , 2 ] , 3 ) == 0.906 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for BRFSS users, this code replicates previously-presented examples: library(srvyr) brfss_srvyr_design <- as_survey( brfss_design ) Calculate the mean (average) of a linear variable, overall and by groups: brfss_srvyr_design %>% summarize( mean = survey_mean( x_age80 ) ) brfss_srvyr_design %>% group_by( state_name ) %>% summarize( mean = survey_mean( x_age80 ) ) "],["consumer-expenditure-survey-ces.html", "Consumer Expenditure Survey (CES) Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Consumer Expenditure Survey (CES) A household budget survey designed to guide major economic indicators like the Consumer Price Index. One table of survey responses per quarter with one row per sampled household (consumer unit). Additional tables containing one record per expenditure. A complex sample survey designed to generalize to the civilian non-institutional U.S. population. Released annually since 1996. Administered by the Bureau of Labor Statistics. Please skim before you begin: Consumer Expenditure Surveys Public Use Microdata Getting Started Guide Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # price indices and # you spent how much on beans, jack? # pocketbook issues Download, Import, Preparation Download both the prior and current year of interview microdata: library(httr) tf_prior_year <- tempfile() this_url_prior_year <- "https://www.bls.gov/cex/pumd/data/stata/intrvw21.zip" dl_prior_year <- GET( this_url_prior_year , user_agent( "email@address.com" ) ) writeBin( content( dl_prior_year ) , tf_prior_year ) unzipped_files_prior_year <- unzip( tf_prior_year , exdir = tempdir() ) tf_current_year <- tempfile() this_url_current_year <- "https://www.bls.gov/cex/pumd/data/stata/intrvw22.zip" dl_current_year <- GET( this_url_current_year , user_agent( "email@address.com" ) ) writeBin( content( dl_current_year ) , tf_current_year ) unzipped_files_current_year <- unzip( tf_current_year , exdir = tempdir() ) unzipped_files <- c( unzipped_files_current_year , unzipped_files_prior_year ) Import and stack all 2022 quarterly files plus 2023’s first quarter: library(haven) fmli_files <- grep( "fmli2[2-3]" , unzipped_files , value = TRUE ) fmli_tbls <- lapply( fmli_files , read_dta ) fmli_dfs <- lapply( fmli_tbls , data.frame ) fmli_dfs <- lapply( fmli_dfs , function( w ){ names( w ) <- tolower( names( w ) ) ; w } ) fmli_cols <- lapply( fmli_dfs , names ) intersecting_cols <- Reduce( intersect , fmli_cols ) fmli_dfs <- lapply( fmli_dfs , function( w ) w[ intersecting_cols ] ) ces_df <- do.call( rbind , fmli_dfs ) Scale the weight columns based on the number of months in 2022: ces_df[ , c( 'qintrvyr' , 'qintrvmo' ) ] <- sapply( ces_df[ , c( 'qintrvyr' , 'qintrvmo' ) ] , as.numeric ) weight_columns <- grep( 'wt' , names( ces_df ) , value = TRUE ) ces_df <- transform( ces_df , mo_scope = ifelse( qintrvyr %in% 2022 & qintrvmo %in% 1:3 , qintrvmo - 1 , ifelse( qintrvyr %in% 2023 , 4 - qintrvmo , 3 ) ) ) for ( this_column in weight_columns ){ ces_df[ is.na( ces_df[ , this_column ] ) , this_column ] <- 0 ces_df[ , paste0( 'popwt_' , this_column ) ] <- ( ces_df[ , this_column ] * ces_df[ , 'mo_scope' ] / 12 ) } Combine previous quarter and current quarter variables into a single variable: expenditure_variables <- gsub( "pq$" , "" , grep( "pq$" , names( ces_df ) , value = TRUE ) ) # confirm that for every variable ending in pq, # there's the same variable ending in cq stopifnot( all( paste0( expenditure_variables , 'cq' ) %in% names( ces_df ) ) ) # confirm none of the variables without the pq or cq suffix exist if( any( expenditure_variables %in% names( ces_df ) ) ) stop( "variable conflict" ) for( this_column in expenditure_variables ){ ces_df[ , this_column ] <- rowSums( ces_df[ , paste0( this_column , c( 'pq' , 'cq' ) ) ] , na.rm = TRUE ) # annualize the quarterly spending ces_df[ , this_column ] <- 4 * ces_df[ , this_column ] ces_df[ is.na( ces_df[ , this_column ] ) , this_column ] <- 0 } Append any interview survey UCC found at https://www.bls.gov/cex/ce_source_integrate.xlsx: ucc_exp <- c( "450110" , "450210" ) mtbi_files <- grep( "mtbi2[2-3]" , unzipped_files , value = TRUE ) mtbi_tbls <- lapply( mtbi_files , read_dta ) mtbi_dfs <- lapply( mtbi_tbls , data.frame ) mtbi_dfs <- lapply( mtbi_dfs , function( w ){ names( w ) <- tolower( names( w ) ) ; w } ) mtbi_dfs <- lapply( mtbi_dfs , function( w ) w[ c( 'newid' , 'cost' , 'ucc' , 'ref_yr' ) ] ) mtbi_df <- do.call( rbind , mtbi_dfs ) mtbi_df <- subset( mtbi_df , ( ref_yr %in% 2022 ) & ( ucc %in% ucc_exp ) ) mtbi_agg <- aggregate( cost ~ newid , data = mtbi_df , sum ) names( mtbi_agg ) <- c( 'newid' , 'new_car_truck_exp' ) before_nrow <- nrow( ces_df ) ces_df <- merge( ces_df , mtbi_agg , all.x = TRUE ) stopifnot( nrow( ces_df ) == before_nrow ) ces_df[ is.na( ces_df[ , 'new_car_truck_exp' ] ) , 'new_car_truck_exp' ] <- 0 Save locally   Save the object at any point: # ces_fn <- file.path( path.expand( "~" ) , "CES" , "this_file.rds" ) # saveRDS( ces_df , file = ces_fn , compress = FALSE ) Load the same object: # ces_df <- readRDS( ces_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: Separate the ces_df data.frame into five implicates, each differing from the others only in the multiply-imputed variables: library(survey) library(mitools) # create a vector containing all of the multiply-imputed variables # (leaving the numbers off the end) mi_vars <- gsub( "5$" , "" , grep( "[a-z]5$" , names( ces_df ) , value = TRUE ) ) # loop through each of the five variables.. for ( i in 1:5 ){ # copy the 'ces_df' table over to a new temporary data frame 'x' x <- ces_df # loop through each of the multiply-imputed variables.. for ( j in mi_vars ){ # copy the contents of the current column (for example 'welfare1') # over to a new column ending in 'mi' (for example 'welfaremi') x[ , paste0( j , 'mi' ) ] <- x[ , paste0( j , i ) ] # delete the all five of the imputed variable columns x <- x[ , !( names( x ) %in% paste0( j , 1:5 ) ) ] } assign( paste0( 'imp' , i ) , x ) } ces_design <- svrepdesign( weights = ~ finlwt21 , repweights = "^wtrep[0-9][0-9]$" , data = imputationList( list( imp1 , imp2 , imp3 , imp4 , imp5 ) ) , type = "BRR" , combined.weights = TRUE , mse = TRUE ) Variable Recoding Add new columns to the data set: ces_design <- update( ces_design , one = 1 , any_food_stamp = as.numeric( jfs_amtmi > 0 ) , bls_urbn = factor( bls_urbn , levels = 1:2 , labels = c( 'urban' , 'rural' ) ) , sex_ref = factor( sex_ref , levels = 1:2 , labels = c( 'male' , 'female' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: MIcombine( with( ces_design , svyby( ~ one , ~ one , unwtd.count ) ) ) MIcombine( with( ces_design , svyby( ~ one , ~ bls_urbn , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: MIcombine( with( ces_design , svytotal( ~ one ) ) ) MIcombine( with( ces_design , svyby( ~ one , ~ bls_urbn , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: MIcombine( with( ces_design , svymean( ~ totexp ) ) ) MIcombine( with( ces_design , svyby( ~ totexp , ~ bls_urbn , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: MIcombine( with( ces_design , svymean( ~ sex_ref ) ) ) MIcombine( with( ces_design , svyby( ~ sex_ref , ~ bls_urbn , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: MIcombine( with( ces_design , svytotal( ~ totexp ) ) ) MIcombine( with( ces_design , svyby( ~ totexp , ~ bls_urbn , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: MIcombine( with( ces_design , svytotal( ~ sex_ref ) ) ) MIcombine( with( ces_design , svyby( ~ sex_ref , ~ bls_urbn , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: MIcombine( with( ces_design , svyquantile( ~ totexp , 0.5 , se = TRUE ) ) ) MIcombine( with( ces_design , svyby( ~ totexp , ~ bls_urbn , svyquantile , 0.5 , se = TRUE , ci = TRUE ) ) ) Estimate a ratio: MIcombine( with( ces_design , svyratio( numerator = ~ totexp , denominator = ~ fincbtxmi ) ) ) Subsetting Restrict the survey design to california residents: sub_ces_design <- subset( ces_design , state == '06' ) Calculate the mean (average) of this subset: MIcombine( with( sub_ces_design , svymean( ~ totexp ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- MIcombine( with( ces_design , svymean( ~ totexp ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- MIcombine( with( ces_design , svyby( ~ totexp , ~ bls_urbn , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( ces_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: MIcombine( with( ces_design , svyvar( ~ totexp ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement MIcombine( with( ces_design , svymean( ~ totexp , deff = TRUE ) ) ) # SRS with replacement MIcombine( with( ces_design , svymean( ~ totexp , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ any_food_stamp , ces_design , # method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( totexp ~ any_food_stamp , ces_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ any_food_stamp + sex_ref , ces_design ) Perform a survey-weighted generalized linear model: glm_result <- MIcombine( with( ces_design , svyglm( totexp ~ any_food_stamp + sex_ref ) ) ) summary( glm_result ) Replication Example This example matches the number of consumer units and the Cars and trucks, new rows of Table R-1: result <- MIcombine( with( ces_design , svytotal( ~ as.numeric( popwt_finlwt21 / finlwt21 ) ) ) ) stopifnot( round( coef( result ) , -3 ) == 134090000 ) results <- sapply( weight_columns , function( this_column ){ sum( ces_df[ , 'new_car_truck_exp' ] * ces_df[ , this_column ] ) / sum( ces_df[ , paste0( 'popwt_' , this_column ) ] ) } ) stopifnot( round( results[1] , 2 ) == 2195.30 ) standard_error <- sqrt( ( 1 / 44 ) * sum( ( results[-1] - results[1] )^2 ) ) stopifnot( round( standard_error , 2 ) == 174.02 ) # note the minor differences MIcombine( with( ces_design , svymean( ~ cartkn ) ) ) "],["census-of-governments-cog.html", "Census of Governments (COG) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Census of Governments (COG) Location, employment, and payroll for state and local (but not federal) government agencies in the U.S. One record per agency, one per agency function, plus the government units master address file. Complete enumeration of civilian employment in state and local governments in the 50 states + D.C. The Annual Survey of Public Employment & Payroll becomes a census in years ending with 2 and 7. Administered and financed by the US Census Bureau. Please skim before you begin: 2022 Census of Governments, Survey of Public Employment & Payroll Methodology Government Units Survey Methodology This human-composed haiku or a bouquet of artificial intelligence-generated limericks # courthouse steps wedding # schools police fire water # no fed mail invite Download, Import, Preparation Download, import, and stack the government units listing file: library(readxl) tf_gus <- tempfile() gus_url <- "https://www2.census.gov/programs-surveys/gus/datasets/2022/govt_units_2022.ZIP" download.file( gus_url , tf_gus , mode = 'wb' ) unzipped_files_gus <- unzip( tf_gus , exdir = tempdir() ) xlsx_gus_fn <- grep( "\\\\.xlsx$" , unzipped_files_gus , value = TRUE ) xlsx_sheets <- excel_sheets( xlsx_gus_fn ) # read all sheets into a list of tibbles gus_tbl_list <- lapply( xlsx_sheets , function( w ) read_excel( xlsx_gus_fn , sheet = w ) ) # convert all tibbles to data.frame objects gus_df_list <- lapply( gus_tbl_list , data.frame ) # lowercase all column names gus_df_list <- lapply( gus_df_list , function( w ){ names( w ) <- tolower( names( w ) ) ; w } ) # add the excel tab source to each data.frame for( i in seq( xlsx_sheets ) ) gus_df_list[[ i ]][ , 'source_tab' ] <- xlsx_sheets[ i ] # determine which columns are in all tables column_intersect <- Reduce( intersect , lapply( gus_df_list , names ) ) # determine which columns are in some but not all tables column_union <- unique( unlist( lapply( gus_df_list , names ) ) ) # these columns will be discarded by stacking: unique( unlist( lapply( lapply( gus_df_list , names ) , function( w ) column_union[ !column_union %in% w ] ) ) ) # stack all excel sheets, keeping only the columns that all tables have in common gus_df <- Reduce( rbind , lapply( gus_df_list , function( w ) w[ column_intersect ] ) ) Download and import the survey of public employment & payroll, one record per function (not per unit): tf_apes <- tempfile() apes_url <- paste0( "https://www2.census.gov/programs-surveys/apes/datasets/" , "2022/2022%20COG-E%20Individual%20Unit%20Files.zip" ) download.file( apes_url , tf_apes , mode = 'wb' ) unzipped_files_apes <- unzip( tf_apes , exdir = tempdir() ) xlsx_apes_fn <- grep( "\\\\.xlsx$" , unzipped_files_apes , value = TRUE ) apes_tbl <- read_excel( xlsx_apes_fn ) apes_df <- data.frame( apes_tbl ) names( apes_df ) <- tolower( names( apes_df ) ) Review the non-matching records between these two tables, then merge: # all DEP School Districts and a third of Special Districts are not in the `apes_df` table( gus_df[ , 'census_id_gidid' ] %in% apes_df[ , 'individual.unit.id' ] , gus_df[ , 'source_tab' ] , useNA = 'always' ) # state governments are not in the `gus_df` table( apes_df[ , 'individual.unit.id' ] %in% gus_df[ , 'census_id_gidid' ] , apes_df[ , 'type.of.government' ] , useNA = 'always' ) # check for overlapping field names: ( overlapping_names <- intersect( names( apes_df ) , names( gus_df ) ) ) # rename the state column in `gus_df` to state abbreviation names( gus_df )[ names( gus_df ) == 'state' ] <- 'stateab' double_df <- merge( apes_df , gus_df , by.x = 'individual.unit.id' , by.y = 'census_id_gidid' , all.x = TRUE ) stopifnot( nrow( double_df ) == nrow( apes_df ) ) # replace dots with underscores names( double_df ) <- gsub( "\\\\." , "_" , names( double_df ) ) Keep either the one record per agency rows or the one record per function rows: # `Total - All Government Employment Functions` records sum to the same as all other records: with( double_df , tapply( full_time_employees , grepl( "Total" , government_function ) , sum ) ) with( double_df , tapply( part_time_payroll , grepl( "Total" , government_function ) , sum ) ) # keep one record per government function (multiple records per agency): cog_df <- subset( double_df , !grepl( "Total" , government_function ) ) # keep one record per government agency: # cog_df <- subset( double_df , grepl( "Total" , government_function ) ) Save locally   Save the object at any point: # cog_fn <- file.path( path.expand( "~" ) , "COG" , "this_file.rds" ) # saveRDS( cog_df , file = cog_fn , compress = FALSE ) Load the same object: # cog_df <- readRDS( cog_fn ) Variable Recoding Add new columns to the data set: cog_df <- transform( cog_df , one = 1 , total_payroll = full_time_payroll + part_time_payroll , total_employees = full_time_employees + part_time_employees , any_full_time_employees = full_time_employees > 0 ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( cog_df ) table( cog_df[ , "type_of_government" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( cog_df[ , "full_time_employees" ] ) tapply( cog_df[ , "full_time_employees" ] , cog_df[ , "type_of_government" ] , mean ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( cog_df[ , "census_region" ] ) ) prop.table( table( cog_df[ , c( "census_region" , "type_of_government" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( cog_df[ , "full_time_employees" ] ) tapply( cog_df[ , "full_time_employees" ] , cog_df[ , "type_of_government" ] , sum ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( cog_df[ , "full_time_employees" ] , 0.5 ) tapply( cog_df[ , "full_time_employees" ] , cog_df[ , "type_of_government" ] , quantile , 0.5 ) Subsetting Limit your data.frame to Elementary, Secondary, Higher, and Other Educational Government Agencies: sub_cog_df <- subset( cog_df , grepl( 'Education' , government_function ) ) Calculate the mean (average) of this subset: mean( sub_cog_df[ , "full_time_employees" ] ) Measures of Uncertainty Calculate the variance, overall and by groups: var( cog_df[ , "full_time_employees" ] ) tapply( cog_df[ , "full_time_employees" ] , cog_df[ , "type_of_government" ] , var ) Regression Models and Tests of Association Perform a t-test: t.test( full_time_employees ~ any_full_time_employees , cog_df ) Perform a chi-squared test of association: this_table <- table( cog_df[ , c( "any_full_time_employees" , "census_region" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( full_time_employees ~ any_full_time_employees + census_region , data = cog_df ) summary( glm_result ) Replication Example This example matches excel cell “C17” of Employment & Payroll Data by State and by Function: financial_admin_df <- subset( cog_df , government_function == 'Financial Administration' ) stopifnot( sum( financial_admin_df[ , 'full_time_employees' ] ) == 404228 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for COG users, this code replicates previously-presented examples: library(dplyr) cog_tbl <- as_tibble( cog_df ) Calculate the mean (average) of a linear variable, overall and by groups: cog_tbl %>% summarize( mean = mean( full_time_employees ) ) cog_tbl %>% group_by( type_of_government ) %>% summarize( mean = mean( full_time_employees ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for COG users, this code replicates previously-presented examples: library(data.table) cog_dt <- data.table( cog_df ) Calculate the mean (average) of a linear variable, overall and by groups: cog_dt[ , mean( full_time_employees ) ] cog_dt[ , mean( full_time_employees ) , by = type_of_government ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for COG users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'cog' , cog_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( full_time_employees ) FROM cog' ) dbGetQuery( con , 'SELECT type_of_government , AVG( full_time_employees ) FROM cog GROUP BY type_of_government' ) "],["current-population-survey-cps.html", "Current Population Survey (CPS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " Current Population Survey (CPS) The principal labor force survey, providing income, poverty, and health insurance coverage estimates. One table with one row per sampled household, a second table with one row per family within each sampled household, and a third table with one row per individual within each of those families. A complex sample designed to generalize to the civilian non-institutional population of the US. Released annually since 1998, linkable to the Basic Monthly releases. Administered jointly by the US Census Bureau and the Bureau of Labor Statistics. Please skim before you begin: Current Population Survey 2023 Annual Social and Economic (ASEC) Supplement Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # jobs robbed by robot # luddite rebellion looming # blue, due to red pill Download, Import, Preparation Download and unzip the 2023 file: library(httr) tf <- tempfile() this_url <- "https://www2.census.gov/programs-surveys/cps/datasets/2023/march/asecpub23sas.zip" GET( this_url , write_disk( tf ) , progress() ) unzipped_files <- unzip( tf , exdir = tempdir() ) Import all four files: library(haven) four_tbl <- lapply( unzipped_files , read_sas ) four_df <- lapply( four_tbl , data.frame ) four_df <- lapply( four_df , function( w ){ names( w ) <- tolower( names( w ) ) ; w } ) household_df <- four_df[[ grep( 'hhpub' , basename( unzipped_files ) ) ]] family_df <- four_df[[ grep( 'ffpub' , basename( unzipped_files ) ) ]] person_df <- four_df[[ grep( 'pppub' , basename( unzipped_files ) ) ]] repwgts_df <- four_df[[ grep( 'repwgt' , basename( unzipped_files ) ) ]] Divide weights: household_df[ , 'hsup_wgt' ] <- household_df[ , 'hsup_wgt' ] / 100 family_df[ , 'fsup_wgt' ] <- family_df[ , 'fsup_wgt' ] / 100 for ( j in c( 'marsupwt' , 'a_ernlwt' , 'a_fnlwgt' ) ) person_df[ , j ] <- person_df[ , j ] / 100 Merge these four files: names( family_df )[ names( family_df ) == 'fh_seq' ] <- 'h_seq' names( person_df )[ names( person_df ) == 'ph_seq' ] <- 'h_seq' names( person_df )[ names( person_df ) == 'phf_seq' ] <- 'ffpos' hh_fm_df <- merge( household_df , family_df ) hh_fm_pr_df <- merge( hh_fm_df , person_df ) cps_df <- merge( hh_fm_pr_df , repwgts_df ) stopifnot( nrow( cps_df ) == nrow( person_df ) ) Save locally   Save the object at any point: # cps_fn <- file.path( path.expand( "~" ) , "CPS" , "this_file.rds" ) # saveRDS( cps_df , file = cps_fn , compress = FALSE ) Load the same object: # cps_df <- readRDS( cps_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) cps_design <- svrepdesign( weights = ~ marsupwt , repweights = "pwwgt[1-9]" , type = "Fay" , rho = ( 1 - 1 / sqrt( 4 ) ) , data = cps_df , combined.weights = TRUE , mse = TRUE ) Variable Recoding Add new columns to the data set: cps_design <- update( cps_design , one = 1 , a_maritl = factor( a_maritl , labels = c( "married - civilian spouse present" , "married - AF spouse present" , "married - spouse absent" , "widowed" , "divorced" , "separated" , "never married" ) ) , state_name = factor( gestfips , levels = c(1L, 2L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 12L, 13L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 53L, 54L, 55L, 56L) , labels = c("Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "District of Columbia", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming") ) , male = as.numeric( a_sex == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( cps_design , "sampling" ) != 0 ) svyby( ~ one , ~ state_name , cps_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , cps_design ) svyby( ~ one , ~ state_name , cps_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ ptotval , cps_design ) svyby( ~ ptotval , ~ state_name , cps_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ a_maritl , cps_design ) svyby( ~ a_maritl , ~ state_name , cps_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ ptotval , cps_design ) svyby( ~ ptotval , ~ state_name , cps_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ a_maritl , cps_design ) svyby( ~ a_maritl , ~ state_name , cps_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ ptotval , cps_design , 0.5 ) svyby( ~ ptotval , ~ state_name , cps_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ moop , denominator = ~ ptotval , cps_design ) Subsetting Restrict the survey design to persons aged 18-64: sub_cps_design <- subset( cps_design , a_age %in% 18:64 ) Calculate the mean (average) of this subset: svymean( ~ ptotval , sub_cps_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ ptotval , cps_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ ptotval , ~ state_name , cps_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( cps_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ ptotval , cps_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ ptotval , cps_design , deff = TRUE ) # SRS with replacement svymean( ~ ptotval , cps_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ male , cps_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( ptotval ~ male , cps_design ) Perform a chi-squared test of association for survey data: svychisq( ~ male + a_maritl , cps_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( ptotval ~ male + a_maritl , cps_design ) summary( glm_result ) Replication Example This example matches the count and share of individuals with health insurance in Table H-01: count_covered <- svytotal( ~ as.numeric( cov == 1 ) , cps_design ) stopifnot( round( coef( count_covered ) , -5 ) == 304000000 ) stopifnot( round( coef( count_covered ) - confint( count_covered , level = 0.9 )[1] , -3 ) == 746000 ) share_covered <- svymean( ~ as.numeric( cov == 1 ) , subset( cps_design , cov > 0 ) ) stopifnot( round( coef( share_covered ) , 3 ) == 0.921 ) stopifnot( round( coef( share_covered ) - confint( share_covered , level = 0.9 )[1] , 3 ) == 0.002 ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for CPS users, this code calculates the gini coefficient on complex sample survey data: library(convey) cps_design <- convey_prep( cps_design ) cps_household_design <- subset( cps_design , a_exprrp %in% 1:2 ) svygini( ~ htotval , cps_household_design ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for CPS users, this code replicates previously-presented examples: library(srvyr) cps_srvyr_design <- as_survey( cps_design ) Calculate the mean (average) of a linear variable, overall and by groups: cps_srvyr_design %>% summarize( mean = survey_mean( ptotval ) ) cps_srvyr_design %>% group_by( state_name ) %>% summarize( mean = survey_mean( ptotval ) ) "],["exame-nacional-de-desempenho-de-estudantes-enade.html", "Exame Nacional de Desempenho de Estudantes (ENADE) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Exame Nacional de Desempenho de Estudantes (ENADE) The nationwide mandatory examination of college graduates. One table with one row per individual undergraduate student in Brazil. An enumeration of undergraduate students in Brazil. Released annually since 2004. Compiled by the Instituto Nacional de Estudos e Pesquisas Educacionais Anísio Teixeira (INEP). Please skim before you begin: Cálculo da nota final do Exame Nacional de Desempenho dos Estudiantes Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # undergraduates # sit for standardized testing # exit interview Download, Import, Preparation Download, import, and merge two of the 2021 files: library(httr) library(archive) tf <- tempfile() this_url <- "https://download.inep.gov.br/microdados/microdados_enade_2021.zip" GET( this_url , write_disk( tf ) , progress() ) archive_extract( tf , dir = tempdir() ) read_enade_archive <- function( this_regular_expression , this_directory ){ this_filename <- grep( this_regular_expression , list.files( this_directory , recursive = TRUE , full.names = TRUE ) , value = TRUE ) this_df <- read.table( this_filename , header = TRUE , sep = ";" , na.strings = "" ) names( this_df ) <- tolower( names( this_df ) ) this_df } arq1_df <- read_enade_archive( 'arq1\\\\.txt$' , tempdir() ) arq1_df <- unique( arq1_df[ c( 'co_curso' , 'co_uf_curso' , 'co_categad' , 'co_grupo' ) ] ) arq3_df <- read_enade_archive( 'arq3\\\\.txt$' , tempdir() ) enade_df <- merge( arq3_df , arq1_df ) stopifnot( nrow( enade_df ) == nrow( arq3_df ) ) Save locally   Save the object at any point: # enade_fn <- file.path( path.expand( "~" ) , "ENADE" , "this_file.rds" ) # saveRDS( enade_df , file = enade_fn , compress = FALSE ) Load the same object: # enade_df <- readRDS( enade_fn ) Variable Recoding Add new columns to the data set: enade_df <- transform( enade_df , # qual foi o tempo gasto por voce para concluir a prova? less_than_two_hours = as.numeric( co_rs_i9 %in% c( 'A' , 'B' ) ) , administrative_category = factor( co_categad , levels = c( 1:5 , 7 ) , labels = c( '1. Pública Federal' , '2. Pública Estadual' , '3. Pública Municipal' , '4. Privada com fins lucrativos' , '5. Privada sem fins lucrativos' , '7. Especial' ) ) , state_name = factor( co_uf_curso , levels = c( 11:17 , 21:29 , 31:33 , 35 , 41:43 , 50:53 ) , labels = c( "Rondonia" , "Acre" , "Amazonas" , "Roraima" , "Para" , "Amapa" , "Tocantins" , "Maranhao" , "Piaui" , "Ceara" , "Rio Grande do Norte" , "Paraiba" , "Pernambuco" , "Alagoas" , "Sergipe" , "Bahia" , "Minas Gerais" , "Espirito Santo" , "Rio de Janeiro" , "Sao Paulo" , "Parana" , "Santa Catarina" , "Rio Grande do Sul" , "Mato Grosso do Sul" , "Mato Grosso" , "Goias" , "Distrito Federal" ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( enade_df ) table( enade_df[ , "administrative_category" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( enade_df[ , "nt_obj_fg" ] , na.rm = TRUE ) tapply( enade_df[ , "nt_obj_fg" ] , enade_df[ , "administrative_category" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( enade_df[ , "state_name" ] ) ) prop.table( table( enade_df[ , c( "state_name" , "administrative_category" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( enade_df[ , "nt_obj_fg" ] , na.rm = TRUE ) tapply( enade_df[ , "nt_obj_fg" ] , enade_df[ , "administrative_category" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( enade_df[ , "nt_obj_fg" ] , 0.5 , na.rm = TRUE ) tapply( enade_df[ , "nt_obj_fg" ] , enade_df[ , "administrative_category" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to students reporting that the general training section was easy or very easy: sub_enade_df <- subset( enade_df , co_rs_i1 %in% c( "A" , "B" ) ) Calculate the mean (average) of this subset: mean( sub_enade_df[ , "nt_obj_fg" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( enade_df[ , "nt_obj_fg" ] , na.rm = TRUE ) tapply( enade_df[ , "nt_obj_fg" ] , enade_df[ , "administrative_category" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( nt_obj_fg ~ less_than_two_hours , enade_df ) Perform a chi-squared test of association: this_table <- table( enade_df[ , c( "less_than_two_hours" , "state_name" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( nt_obj_fg ~ less_than_two_hours + state_name , data = enade_df ) summary( glm_result ) Replication Example This example matches the tecnologia em gestão da tecnologia da informação test scores on PDF page 48 of the 2021 final results document: it_students <- subset( enade_df , co_grupo %in% 6409 ) results <- sapply( it_students[ c( 'nt_fg' , 'nt_ce' , 'nt_ger' ) ] , mean , na.rm = TRUE ) stopifnot( round( results[ 'nt_fg' ] , 1 ) == 30.4 ) stopifnot( round( results[ 'nt_ce' ] , 1 ) == 38.2 ) stopifnot( round( results[ 'nt_ger' ] , 1 ) == 36.3 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for ENADE users, this code replicates previously-presented examples: library(dplyr) enade_tbl <- as_tibble( enade_df ) Calculate the mean (average) of a linear variable, overall and by groups: enade_tbl %>% summarize( mean = mean( nt_obj_fg , na.rm = TRUE ) ) enade_tbl %>% group_by( administrative_category ) %>% summarize( mean = mean( nt_obj_fg , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for ENADE users, this code replicates previously-presented examples: library(data.table) enade_dt <- data.table( enade_df ) Calculate the mean (average) of a linear variable, overall and by groups: enade_dt[ , mean( nt_obj_fg , na.rm = TRUE ) ] enade_dt[ , mean( nt_obj_fg , na.rm = TRUE ) , by = administrative_category ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for ENADE users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'enade' , enade_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( nt_obj_fg ) FROM enade' ) dbGetQuery( con , 'SELECT administrative_category , AVG( nt_obj_fg ) FROM enade GROUP BY administrative_category' ) "],["exame-nacional-do-ensino-medio-enem.html", "Exame Nacional do Ensino Medio (ENEM) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Exame Nacional do Ensino Medio (ENEM) The national student aptitude test, used to assess high school completion and university admission. One table with one row per test-taking student, a second of study habit questionnaire respondents. Updated annually since 1998. Maintained by Brazil’s Instituto Nacional de Estudos e Pesquisas Educacionais Anisio Teixeira Please skim before you begin: Leia_Me_Enem included in each annual zipped file Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # graduation stage # shake hands, toss cap, unroll scroll, # mais um exame? Download, Import, Preparation Download and unzip the 2022 file: library(httr) library(archive) tf <- tempfile() this_url <- "https://download.inep.gov.br/microdados/microdados_enem_2022.zip" GET( this_url , write_disk( tf ) , progress() ) archive_extract( tf , dir = tempdir() ) Import the 2022 file: library(readr) enem_fns <- list.files( tempdir() , recursive = TRUE , full.names = TRUE ) enem_fn <- grep( "MICRODADOS_ENEM_([0-9][0-9][0-9][0-9])\\\\.csv$" , enem_fns , value = TRUE ) enem_tbl <- read_csv2( enem_fn , locale = locale( encoding = 'latin1' ) ) enem_df <- data.frame( enem_tbl ) names( enem_df ) <- tolower( names( enem_df ) ) Save locally   Save the object at any point: # enem_fn <- file.path( path.expand( "~" ) , "ENEM" , "this_file.rds" ) # saveRDS( enem_df , file = enem_fn , compress = FALSE ) Load the same object: # enem_df <- readRDS( enem_fn ) Variable Recoding Add new columns to the data set: enem_df <- transform( enem_df , domestic_worker = as.numeric( q007 %in% c( 'B' , 'C' , 'D' ) ) , administrative_category = factor( tp_dependencia_adm_esc , levels = 1:4 , labels = c( 'Federal' , 'Estadual' , 'Municipal' , 'Privada' ) ) , state_name = factor( co_uf_esc , levels = c( 11:17 , 21:29 , 31:33 , 35 , 41:43 , 50:53 ) , labels = c( "Rondonia" , "Acre" , "Amazonas" , "Roraima" , "Para" , "Amapa" , "Tocantins" , "Maranhao" , "Piaui" , "Ceara" , "Rio Grande do Norte" , "Paraiba" , "Pernambuco" , "Alagoas" , "Sergipe" , "Bahia" , "Minas Gerais" , "Espirito Santo" , "Rio de Janeiro" , "Sao Paulo" , "Parana" , "Santa Catarina" , "Rio Grande do Sul" , "Mato Grosso do Sul" , "Mato Grosso" , "Goias" , "Distrito Federal" ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( enem_df ) table( enem_df[ , "administrative_category" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( enem_df[ , "nu_nota_mt" ] , na.rm = TRUE ) tapply( enem_df[ , "nu_nota_mt" ] , enem_df[ , "administrative_category" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( enem_df[ , "state_name" ] ) ) prop.table( table( enem_df[ , c( "state_name" , "administrative_category" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( enem_df[ , "nu_nota_mt" ] , na.rm = TRUE ) tapply( enem_df[ , "nu_nota_mt" ] , enem_df[ , "administrative_category" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( enem_df[ , "nu_nota_mt" ] , 0.5 , na.rm = TRUE ) tapply( enem_df[ , "nu_nota_mt" ] , enem_df[ , "administrative_category" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to mother graduated from high school: sub_enem_df <- subset( enem_df , q002 %in% c( 'E' , 'F' , 'G' ) ) Calculate the mean (average) of this subset: mean( sub_enem_df[ , "nu_nota_mt" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( enem_df[ , "nu_nota_mt" ] , na.rm = TRUE ) tapply( enem_df[ , "nu_nota_mt" ] , enem_df[ , "administrative_category" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( nu_nota_mt ~ domestic_worker , enem_df ) Perform a chi-squared test of association: this_table <- table( enem_df[ , c( "domestic_worker" , "state_name" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( nu_nota_mt ~ domestic_worker + state_name , data = enem_df ) summary( glm_result ) Replication Example This example matches the registration counts in the Sinopse ENEM 2022 Excel table: stopifnot( nrow( enem_df ) == 3476105 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for ENEM users, this code replicates previously-presented examples: library(dplyr) enem_tbl <- as_tibble( enem_df ) Calculate the mean (average) of a linear variable, overall and by groups: enem_tbl %>% summarize( mean = mean( nu_nota_mt , na.rm = TRUE ) ) enem_tbl %>% group_by( administrative_category ) %>% summarize( mean = mean( nu_nota_mt , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for ENEM users, this code replicates previously-presented examples: library(data.table) enem_dt <- data.table( enem_df ) Calculate the mean (average) of a linear variable, overall and by groups: enem_dt[ , mean( nu_nota_mt , na.rm = TRUE ) ] enem_dt[ , mean( nu_nota_mt , na.rm = TRUE ) , by = administrative_category ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for ENEM users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'enem' , enem_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( nu_nota_mt ) FROM enem' ) dbGetQuery( con , 'SELECT administrative_category , AVG( nu_nota_mt ) FROM enem GROUP BY administrative_category' ) "],["european-social-survey-ess.html", "European Social Survey (ESS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " European Social Survey (ESS) The barometer of political opinion and behavior across the continent. One table per country with one row per sampled respondent. A complex sample designed to generalize to residents aged 15 and older in participating nations. Released biennially since 2002. Headquartered at City, University of London and governed by a scientific team across Europe. Please skim before you begin: Findings from the European Social Survey Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # pent up belief gauge # open border monarchists # survey for your thoughts Download, Import, Preparation Register at the ESS Data Portal at https://ess-search.nsd.no/. Choose ESS round 8 - 2016. Welfare attitudes, Attitudes to climate change. Download the integrated file and also the sample design (SDDF) files as SAV (SPSS) files: library(foreign) ess_int_df <- read.spss( file.path( path.expand( "~" ) , "ESS8e02_2.sav" ) , to.data.frame = TRUE , use.value.labels = FALSE ) ess_sddf_df <- read.spss( file.path( path.expand( "~" ) , "ESS8SDDFe01_1.sav" ) , to.data.frame = TRUE , use.value.labels = FALSE ) ess_df <- merge( ess_int_df , ess_sddf_df , by = c( 'cntry' , 'idno' ) ) stopifnot( nrow( ess_df ) == nrow( ess_int_df ) ) Save locally   Save the object at any point: # ess_fn <- file.path( path.expand( "~" ) , "ESS" , "this_file.rds" ) # saveRDS( ess_df , file = ess_fn , compress = FALSE ) Load the same object: # ess_df <- readRDS( ess_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) options( survey.lonely.psu = "adjust" ) ess_df[ , 'anweight' ] <- ess_df[ , 'pspwght' ] * ess_df[ , 'pweight' ] * 10000 ess_design <- svydesign( ids = ~psu , strata = ~stratum , weights = ~anweight , data = ess_df , nest = TRUE ) Variable Recoding Add new columns to the data set: ess_design <- update( ess_design , one = 1 , gndr = factor( gndr , labels = c( 'male' , 'female' ) ) , netusoft = factor( netusoft , levels = 1:5 , labels = c( 'Never' , 'Only occasionally' , 'A few times a week' , 'Most days' , 'Every day' ) ) , belonging_to_particular_religion = as.numeric( rlgblg == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( ess_design , "sampling" ) != 0 ) svyby( ~ one , ~ cntry , ess_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , ess_design ) svyby( ~ one , ~ cntry , ess_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ ppltrst , ess_design , na.rm = TRUE ) svyby( ~ ppltrst , ~ cntry , ess_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ gndr , ess_design , na.rm = TRUE ) svyby( ~ gndr , ~ cntry , ess_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ ppltrst , ess_design , na.rm = TRUE ) svyby( ~ ppltrst , ~ cntry , ess_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ gndr , ess_design , na.rm = TRUE ) svyby( ~ gndr , ~ cntry , ess_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ ppltrst , ess_design , 0.5 , na.rm = TRUE ) svyby( ~ ppltrst , ~ cntry , ess_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ ppltrst , denominator = ~ pplfair , ess_design , na.rm = TRUE ) Subsetting Restrict the survey design to voters: sub_ess_design <- subset( ess_design , vote == 1 ) Calculate the mean (average) of this subset: svymean( ~ ppltrst , sub_ess_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ ppltrst , ess_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ ppltrst , ~ cntry , ess_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( ess_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ ppltrst , ess_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ ppltrst , ess_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ ppltrst , ess_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ belonging_to_particular_religion , ess_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( ppltrst ~ belonging_to_particular_religion , ess_design ) Perform a chi-squared test of association for survey data: svychisq( ~ belonging_to_particular_religion + gndr , ess_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( ppltrst ~ belonging_to_particular_religion + gndr , ess_design ) summary( glm_result ) Replication Example This example matches statistics and confidence intervals within 0.1% from the Guide to Using Weights and Sample Design Indicators with ESS Data: published_proportions <- c( 0.166 , 0.055 , 0.085 , 0.115 , 0.578 ) published_lb <- c( 0.146 , 0.045 , 0.072 , 0.099 , 0.550 ) published_ub <- c( 0.188 , 0.068 , 0.100 , 0.134 , 0.605 ) austrians <- subset( ess_design , cntry == 'AT' ) ( results <- svymean( ~ netusoft , austrians , na.rm = TRUE ) ) stopifnot( all( round( coef( results ) , 3 ) == published_proportions ) ) ( ci_results <- confint( results ) ) stopifnot( all( abs( ci_results[ , 1 ] - published_lb ) < 0.0015 ) ) stopifnot( all( abs( ci_results[ , 2 ] - published_ub ) < 0.0015 ) ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for ESS users, this code replicates previously-presented examples: library(srvyr) ess_srvyr_design <- as_survey( ess_design ) Calculate the mean (average) of a linear variable, overall and by groups: ess_srvyr_design %>% summarize( mean = survey_mean( ppltrst , na.rm = TRUE ) ) ess_srvyr_design %>% group_by( cntry ) %>% summarize( mean = survey_mean( ppltrst , na.rm = TRUE ) ) "],["fda-adverse-event-reporting-system-faers.html", "FDA Adverse Event Reporting System (FAERS) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " FDA Adverse Event Reporting System (FAERS) The post-marketing safety surveillance program for drug and therapeutic biological products. Multiple tables linked by primaryid including demographics, outcomes, drug start and end dates. Voluntary reports from practitioners and patients, not representative, no verification of causality. Published quarterly since 2004, file structure revisions at 2012Q4 and 2014Q3. Maintained by the United States Food and Drug Administration (FDA). Please skim before you begin: ASC_NTS.DOC included in each quarterly zipped file, especially the Entity Relationship Diagram Questions and Answers on FDA’s Adverse Event Reporting System (FAERS) This human-composed haiku or a bouquet of artificial intelligence-generated limericks # side effect guestbook # violet you're turning violet # vi'lent dose response Download, Import, Preparation Download the quarterly file: library(httr) tf <- tempfile() this_url <- "https://fis.fda.gov/content/Exports/faers_ascii_2023q1.zip" GET( this_url , write_disk( tf ) , progress() ) unzipped_files <- unzip( tf , exdir = tempdir() ) Define a function to import each text file: read_faers <- function( this_fn ){ read.table( this_fn , sep = "$" , header = TRUE , comment.char = "" , quote = "" ) } Import multiple tables from the downloaded quarter of microdata: # one record per report faers_demo_df <- read_faers( grep( 'DEMO23Q1\\\\.txt$' , unzipped_files , value = TRUE ) ) # one or more record per report faers_drug_df <- read_faers( grep( 'DRUG23Q1\\\\.txt$' , unzipped_files , value = TRUE ) ) # zero or more records per report faers_outcome_df <- read_faers( grep( 'OUTC23Q1\\\\.txt$' , unzipped_files , value = TRUE ) ) Construct an analysis file limited to reported deaths: # limit the outcome file to deaths faers_deaths_df <- subset( faers_outcome_df , outc_cod == 'DE' ) # merge demographics with each reported death faers_df <- merge( faers_demo_df , faers_deaths_df ) # confirm that the analysis file matches the number of death outcomes stopifnot( nrow( faers_deaths_df ) == nrow( faers_df ) ) # confirm zero reports include multiple deaths from the same reported adverse event stopifnot( nrow( faers_df ) == length( unique( faers_df[ , 'primaryid' ] ) ) ) Save locally   Save the object at any point: # faers_fn <- file.path( path.expand( "~" ) , "FAERS" , "this_file.rds" ) # saveRDS( faers_df , file = faers_fn , compress = FALSE ) Load the same object: # faers_df <- readRDS( faers_fn ) Variable Recoding Add new columns to the data set: faers_df <- transform( faers_df , physician_reported = as.numeric( occp_cod == "MD" ) , reporter_country_categories = ifelse( reporter_country == 'US' , 'USA' , ifelse( reporter_country == 'COUNTRY NOT SPECIFIED' , 'missing' , ifelse( reporter_country == 'JP' , 'Japan' , ifelse( reporter_country == 'UK' , 'UK' , ifelse( reporter_country == 'CA' , 'Canada' , ifelse( reporter_country == 'FR' , 'France' , 'Other' ) ) ) ) ) ) , init_fda_year = as.numeric( substr( init_fda_dt , 1 , 4 ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( faers_df ) table( faers_df[ , "reporter_country_categories" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( faers_df[ , "init_fda_year" ] , na.rm = TRUE ) tapply( faers_df[ , "init_fda_year" ] , faers_df[ , "reporter_country_categories" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( faers_df[ , "sex" ] ) ) prop.table( table( faers_df[ , c( "sex" , "reporter_country_categories" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( faers_df[ , "init_fda_year" ] , na.rm = TRUE ) tapply( faers_df[ , "init_fda_year" ] , faers_df[ , "reporter_country_categories" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( faers_df[ , "init_fda_year" ] , 0.5 , na.rm = TRUE ) tapply( faers_df[ , "init_fda_year" ] , faers_df[ , "reporter_country_categories" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to elderly persons: sub_faers_df <- subset( faers_df , age_grp == "E" ) Calculate the mean (average) of this subset: mean( sub_faers_df[ , "init_fda_year" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( faers_df[ , "init_fda_year" ] , na.rm = TRUE ) tapply( faers_df[ , "init_fda_year" ] , faers_df[ , "reporter_country_categories" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( init_fda_year ~ physician_reported , faers_df ) Perform a chi-squared test of association: this_table <- table( faers_df[ , c( "physician_reported" , "sex" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( init_fda_year ~ physician_reported + sex , data = faers_df ) summary( glm_result ) Replication Example This example matches the death frequency counts in the OUTC23Q1.pdf file in the downloaded quarter: stopifnot( nrow( faers_df ) == 37704 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for FAERS users, this code replicates previously-presented examples: library(dplyr) faers_tbl <- as_tibble( faers_df ) Calculate the mean (average) of a linear variable, overall and by groups: faers_tbl %>% summarize( mean = mean( init_fda_year , na.rm = TRUE ) ) faers_tbl %>% group_by( reporter_country_categories ) %>% summarize( mean = mean( init_fda_year , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for FAERS users, this code replicates previously-presented examples: library(data.table) faers_dt <- data.table( faers_df ) Calculate the mean (average) of a linear variable, overall and by groups: faers_dt[ , mean( init_fda_year , na.rm = TRUE ) ] faers_dt[ , mean( init_fda_year , na.rm = TRUE ) , by = reporter_country_categories ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for FAERS users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'faers' , faers_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( init_fda_year ) FROM faers' ) dbGetQuery( con , 'SELECT reporter_country_categories , AVG( init_fda_year ) FROM faers GROUP BY reporter_country_categories' ) "],["general-social-survey-gss.html", "General Social Survey (GSS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " General Social Survey (GSS) A historical record of the concerns, experiences, attitudes, and practices of residents of the United States. Both cross-sectional and panel tables with one row per sampled respondent. A complex sample survey generalizing to non-institutionalized adults (18+) in the United States. Updated biennially since 1972. Funded by National Science Foundation, administered by the National Opinion Research Center. Please skim before you begin: DOCUMENTATION AND PUBLIC USE FILE CODEBOOK (Release 1) Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # chat about who will # be allowed marriage, children. # first date questionnaire Download, Import, Preparation Download and import the 1972-2022 cumulative data file: library(haven) zip_tf <- tempfile() zip_url <- "https://gss.norc.org/Documents/sas/GSS_sas.zip" download.file( zip_url , zip_tf , mode = 'wb' ) unzipped_files <- unzip( zip_tf , exdir = tempdir() ) gss_tbl <- read_sas( grep( '\\\\.sas7bdat$' , unzipped_files , value = TRUE ) ) gss_df <- data.frame( gss_tbl ) names( gss_df ) <- tolower( names( gss_df ) ) gss_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # gss_fn <- file.path( path.expand( "~" ) , "GSS" , "this_file.rds" ) # saveRDS( gss_df , file = gss_fn , compress = FALSE ) Load the same object: # gss_df <- readRDS( gss_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) options( survey.lonely.psu = "adjust" ) gss_design <- svydesign( ~ vpsu , strata = ~ interaction( year , vstrat ) , data = subset( gss_df , year >= 1975 ) , weights = ~ wtsscomp , nest = TRUE ) Variable Recoding Add new columns to the data set: gss_design <- update( gss_design , polviews = factor( polviews , levels = 1:7 , labels = c( "Extremely liberal" , "Liberal" , "Slightly liberal" , "Moderate, middle of the road" , "Slightly conservative" , "Conservative" , "Extremely conservative" ) ) , born_in_usa = as.numeric( born == 1 ) , race = factor( race , levels = 1:3 , labels = c( "white" , "black" , "other" ) ) , region = factor( region , levels = 1:9 , labels = c( "New England" , "Middle Atlantic" , "East North Central" , "West North Central" , "South Atlantic" , "East South Central" , "West South Central" , "Mountain" , "Pacific" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( gss_design , "sampling" ) != 0 ) svyby( ~ one , ~ region , gss_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , gss_design ) svyby( ~ one , ~ region , gss_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ age , gss_design , na.rm = TRUE ) svyby( ~ age , ~ region , gss_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ race , gss_design , na.rm = TRUE ) svyby( ~ race , ~ region , gss_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ age , gss_design , na.rm = TRUE ) svyby( ~ age , ~ region , gss_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ race , gss_design , na.rm = TRUE ) svyby( ~ race , ~ region , gss_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ age , gss_design , 0.5 , na.rm = TRUE ) svyby( ~ age , ~ region , gss_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ adults , denominator = ~ hompop , gss_design , na.rm = TRUE ) Subsetting Restrict the survey design to females: sub_gss_design <- subset( gss_design , sex == 2 ) Calculate the mean (average) of this subset: svymean( ~ age , sub_gss_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ age , gss_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ age , ~ region , gss_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( gss_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ age , gss_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ age , gss_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ age , gss_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ born_in_usa , gss_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( age ~ born_in_usa , gss_design ) Perform a chi-squared test of association for survey data: svychisq( ~ born_in_usa + race , gss_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( age ~ born_in_usa + race , gss_design ) summary( glm_result ) Replication Example Match the unweighted record count on PDF page 10 of the Public Use File codebook: stopifnot( nrow( subset( gss_design , year == 2022 ) ) == 3544 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for GSS users, this code replicates previously-presented examples: library(srvyr) gss_srvyr_design <- as_survey( gss_design ) Calculate the mean (average) of a linear variable, overall and by groups: gss_srvyr_design %>% summarize( mean = survey_mean( age , na.rm = TRUE ) ) gss_srvyr_design %>% group_by( region ) %>% summarize( mean = survey_mean( age , na.rm = TRUE ) ) "],["medicare-current-beneficiary-survey-mcbs.html", "Medicare Current Beneficiary Survey (MCBS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Medicare Current Beneficiary Survey (MCBS) The monitoring system for Medicare enrollees in the United States on topics not available in the program’s administrative data, such as out of pocket expenditure and beneficiary satisfaction. Survey and supplemental tables with one row per sampled individual, although downloadable datasets not linkable. A complex sample survey designed to generalize to all elderly and disabled individuals with at least one month of program enrollment during the calendar year. Released annually as a public use file since 2015. Conducted by the Office of Enterprise Data and Analytics (OEDA) of the Centers for Medicare & Medicaid Services (CMS) through a contract with NORC at the University of Chicago. Please skim before you begin: MCBS Methodology Report MCBS Advanced Tutorial on Weighting and Variance Estimation This human-composed haiku or a bouquet of artificial intelligence-generated limericks # old, or disabled # access to medical care, # utilization Download, Import, Preparation tf <- tempfile() this_url <- "https://www.cms.gov/files/zip/cspuf2019.zip" download.file( this_url , tf , mode = 'wb' ) unzipped_files <- unzip( tf , exdir = tempdir() ) mcbs_csv <- grep( '\\\\.csv$' , unzipped_files , value = TRUE ) mcbs_df <- read.csv( mcbs_csv ) names( mcbs_df ) <- tolower( names( mcbs_df ) ) Save locally   Save the object at any point: # mcbs_fn <- file.path( path.expand( "~" ) , "MCBS" , "this_file.rds" ) # saveRDS( mcbs_df , file = mcbs_fn , compress = FALSE ) Load the same object: # mcbs_df <- readRDS( mcbs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) mcbs_design <- svrepdesign( weight = ~cspufwgt , repweights = 'cspuf[0-9]+' , mse = TRUE , type = 'Fay' , rho = 0.3 , data = mcbs_df ) Variable Recoding Add new columns to the data set: mcbs_design <- update( mcbs_design , one = 1 , csp_age = factor( csp_age , levels = 1:3 , labels = c( '01: younger than 65' , '02: 65 to 74' , '03: 75 or older' ) ) , two_or_more_chronic_conditions = as.numeric( csp_nchrncnd > 1 ) , csp_sex = factor( csp_sex , labels = c( 'male' , 'female' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( mcbs_design , "sampling" ) != 0 ) svyby( ~ one , ~ csp_age , mcbs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , mcbs_design ) svyby( ~ one , ~ csp_age , mcbs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ pamtoop , mcbs_design ) svyby( ~ pamtoop , ~ csp_age , mcbs_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ csp_sex , mcbs_design ) svyby( ~ csp_sex , ~ csp_age , mcbs_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ pamtoop , mcbs_design ) svyby( ~ pamtoop , ~ csp_age , mcbs_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ csp_sex , mcbs_design ) svyby( ~ csp_sex , ~ csp_age , mcbs_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ pamtoop , mcbs_design , 0.5 ) svyby( ~ pamtoop , ~ csp_age , mcbs_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ pamtoop , denominator = ~ pamttot , mcbs_design ) Subsetting Restrict the survey design to household income below $25,000: sub_mcbs_design <- subset( mcbs_design , csp_income == 1 ) Calculate the mean (average) of this subset: svymean( ~ pamtoop , sub_mcbs_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ pamtoop , mcbs_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ pamtoop , ~ csp_age , mcbs_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( mcbs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ pamtoop , mcbs_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ pamtoop , mcbs_design , deff = TRUE ) # SRS with replacement svymean( ~ pamtoop , mcbs_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ two_or_more_chronic_conditions , mcbs_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( pamtoop ~ two_or_more_chronic_conditions , mcbs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ two_or_more_chronic_conditions + csp_sex , mcbs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( pamtoop ~ two_or_more_chronic_conditions + csp_sex , mcbs_design ) summary( glm_result ) Replication Example This example matches the weighted total from the 2019 Data User’s Guide: Cost Supplement File Public Use File: stopifnot( round( coef( svytotal( ~ one , mcbs_design ) ) , 0 ) == 56307461 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for MCBS users, this code replicates previously-presented examples: library(srvyr) mcbs_srvyr_design <- as_survey( mcbs_design ) Calculate the mean (average) of a linear variable, overall and by groups: mcbs_srvyr_design %>% summarize( mean = survey_mean( pamtoop ) ) mcbs_srvyr_design %>% group_by( csp_age ) %>% summarize( mean = survey_mean( pamtoop ) ) "],["medical-expenditure-panel-survey-meps.html", "Medical Expenditure Panel Survey (MEPS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Medical Expenditure Panel Survey (MEPS) The Household Component captures person-level spending across service categories, coverage types. The consolidated file contains one row per individual within each sampled household, other tables contain one record per event (like prescription fills, hospitalizations), per job, per insurance policy. A complex sample survey designed to generalize to the U.S. civilian non-institutionalized population. Released annually since 1996. Administered by the Agency for Healthcare Research and Quality. Please skim before you begin: MEPS HC-224 2020 Full Year Consolidated Data File Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # king dumpty's horsemen # ahrq stitches payors, bills, claims # fractured health system Download, Import, Preparation Define a function to download, unzip, and import each sas file: library(haven) meps_sas_import <- function( this_url ){ this_tf <- tempfile() download.file( this_url , this_tf , mode = 'wb' ) this_tbl <- read_sas( this_tf ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the consolidated file and the replicate weights file: meps_cons_df <- meps_sas_import( "https://meps.ahrq.gov/data_files/pufs/h224/h224v9.zip" ) meps_brr_df <- meps_sas_import( "https://meps.ahrq.gov/mepsweb/data_files/pufs/h036brr/h36brr20v9.zip" ) Merge the consolidated file with the replicate weights: meps_df <- merge( meps_cons_df , meps_brr_df ) stopifnot( nrow( meps_df ) == nrow( meps_cons_df ) ) meps_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # meps_fn <- file.path( path.expand( "~" ) , "MEPS" , "this_file.rds" ) # saveRDS( meps_df , file = meps_fn , compress = FALSE ) Load the same object: # meps_df <- readRDS( meps_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) meps_design <- svrepdesign( data = meps_df , weights = ~ perwt20f , type = "BRR" , combined.weights = FALSE , repweights = "brr[1-9]+" , mse = TRUE ) Variable Recoding Add new columns to the data set: meps_design <- update( meps_design , one = 1 , insured_december_31st = ifelse( ins20x %in% 1:2 , as.numeric( ins20x == 1 ) , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( meps_design , "sampling" ) != 0 ) svyby( ~ one , ~ region20 , meps_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , meps_design ) svyby( ~ one , ~ region20 , meps_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ totexp20 , meps_design ) svyby( ~ totexp20 , ~ region20 , meps_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ sex , meps_design ) svyby( ~ sex , ~ region20 , meps_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ totexp20 , meps_design ) svyby( ~ totexp20 , ~ region20 , meps_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ sex , meps_design ) svyby( ~ sex , ~ region20 , meps_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ totexp20 , meps_design , 0.5 ) svyby( ~ totexp20 , ~ region20 , meps_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ totmcd20 , denominator = ~ totexp20 , meps_design ) Subsetting Restrict the survey design to seniors: sub_meps_design <- subset( meps_design , agelast >= 65 ) Calculate the mean (average) of this subset: svymean( ~ totexp20 , sub_meps_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ totexp20 , meps_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ totexp20 , ~ region20 , meps_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( meps_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ totexp20 , meps_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ totexp20 , meps_design , deff = TRUE ) # SRS with replacement svymean( ~ totexp20 , meps_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ insured_december_31st , meps_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( totexp20 ~ insured_december_31st , meps_design ) Perform a chi-squared test of association for survey data: svychisq( ~ insured_december_31st + sex , meps_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( totexp20 ~ insured_december_31st + sex , meps_design ) summary( glm_result ) Replication Example This example matches the statistic and standard error shown under Analysis of the Total Population: library(foreign) xport_2002_tf <- tempfile() xport_2002_url <- "https://meps.ahrq.gov/data_files/pufs/h70ssp.zip" download.file( xport_2002_url , xport_2002_tf , mode = 'wb' ) unzipped_2002_xport <- unzip( xport_2002_tf , exdir = tempdir() ) meps_2002_df <- read.xport( unzipped_2002_xport ) names( meps_2002_df ) <- tolower( names( meps_2002_df ) ) meps_2002_design <- svydesign( ~ varpsu , strata = ~ varstr , weights = ~ perwt02f , data = meps_2002_df , nest = TRUE ) result <- svymean( ~ totexp02 , meps_2002_design ) stopifnot( round( coef( result ) , 2 ) == 2813.24 ) stopifnot( round( SE( result ) , 2 ) == 58.99 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for MEPS users, this code replicates previously-presented examples: library(srvyr) meps_srvyr_design <- as_survey( meps_design ) Calculate the mean (average) of a linear variable, overall and by groups: meps_srvyr_design %>% summarize( mean = survey_mean( totexp20 ) ) meps_srvyr_design %>% group_by( region20 ) %>% summarize( mean = survey_mean( totexp20 ) ) "],["medical-large-claims-experience-study-mlces.html", "Medical Large Claims Experience Study (MLCES) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Medical Large Claims Experience Study (MLCES) A high quality dataset of medical claims from seven private health insurance companies. One table with one row per individual with nonzero total paid charges. A convenience sample of group (employer-sponsored) health insurers in the United States. 1997 thru 1999 with no expected updates in the future. Provided by the Society of Actuaries (SOA). Please skim before you begin: Group Medical Insurance Claims Database Collection and Analysis Report Claim Severities, Claim Relativities, and Age: Evidence from SOA Group Health Data This human-composed haiku or a bouquet of artificial intelligence-generated limericks # skewed by black swan tails # means, medians sing adieu # claims distribution Download, Import, Preparation Download and import the 1999 medical claims file: tf <- tempfile() this_url <- "https://www.soa.org/Files/Research/1999.zip" download.file( this_url , tf , mode = 'wb' ) unzipped_file <- unzip( tf , exdir = tempdir() ) mlces_df <- read.csv( unzipped_file ) names( mlces_df ) <- tolower( names( mlces_df ) ) Save locally   Save the object at any point: # mlces_fn <- file.path( path.expand( "~" ) , "MLCES" , "this_file.rds" ) # saveRDS( mlces_df , file = mlces_fn , compress = FALSE ) Load the same object: # mlces_df <- readRDS( mlces_fn ) Variable Recoding Add new columns to the data set: mlces_df <- transform( mlces_df , one = 1 , claimant_relationship_to_policyholder = ifelse( relation == "E" , "covered employee" , ifelse( relation == "S" , "spouse of covered employee" , ifelse( relation == "D" , "dependent of covered employee" , NA ) ) ) , ppo_plan = as.numeric( ppo == 'Y' ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( mlces_df ) table( mlces_df[ , "claimant_relationship_to_policyholder" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( mlces_df[ , "totpdchg" ] ) tapply( mlces_df[ , "totpdchg" ] , mlces_df[ , "claimant_relationship_to_policyholder" ] , mean ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( mlces_df[ , "patsex" ] ) ) prop.table( table( mlces_df[ , c( "patsex" , "claimant_relationship_to_policyholder" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( mlces_df[ , "totpdchg" ] ) tapply( mlces_df[ , "totpdchg" ] , mlces_df[ , "claimant_relationship_to_policyholder" ] , sum ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( mlces_df[ , "totpdchg" ] , 0.5 ) tapply( mlces_df[ , "totpdchg" ] , mlces_df[ , "claimant_relationship_to_policyholder" ] , quantile , 0.5 ) Subsetting Limit your data.frame to persons under 18: sub_mlces_df <- subset( mlces_df , ( ( claimyr - patbrtyr ) < 18 ) ) Calculate the mean (average) of this subset: mean( sub_mlces_df[ , "totpdchg" ] ) Measures of Uncertainty Calculate the variance, overall and by groups: var( mlces_df[ , "totpdchg" ] ) tapply( mlces_df[ , "totpdchg" ] , mlces_df[ , "claimant_relationship_to_policyholder" ] , var ) Regression Models and Tests of Association Perform a t-test: t.test( totpdchg ~ ppo_plan , mlces_df ) Perform a chi-squared test of association: this_table <- table( mlces_df[ , c( "ppo_plan" , "patsex" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( totpdchg ~ ppo_plan + patsex , data = mlces_df ) summary( glm_result ) Replication Example This example matches statistics in Table II-A’s 1999 row numbers 52 and 53 from the Database: Match Claimants Exceeding Deductible: # $0 deductible stopifnot( nrow( mlces_df ) == 1591738 ) # $1,000 deductible mlces_above_1000_df <- subset( mlces_df , totpdchg > 1000 ) stopifnot( nrow( mlces_above_1000_df ) == 402550 ) Match the Excess Charges Above Deductible: # $0 deductible stopifnot( round( sum( mlces_df[ , 'totpdchg' ] ) , 0 ) == 2599356658 ) # $1,000 deductible stopifnot( round( sum( mlces_above_1000_df[ , 'totpdchg' ] - 1000 ) , 0 ) == 1883768786 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for MLCES users, this code replicates previously-presented examples: library(dplyr) mlces_tbl <- as_tibble( mlces_df ) Calculate the mean (average) of a linear variable, overall and by groups: mlces_tbl %>% summarize( mean = mean( totpdchg ) ) mlces_tbl %>% group_by( claimant_relationship_to_policyholder ) %>% summarize( mean = mean( totpdchg ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for MLCES users, this code replicates previously-presented examples: library(data.table) mlces_dt <- data.table( mlces_df ) Calculate the mean (average) of a linear variable, overall and by groups: mlces_dt[ , mean( totpdchg ) ] mlces_dt[ , mean( totpdchg ) , by = claimant_relationship_to_policyholder ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for MLCES users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'mlces' , mlces_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( totpdchg ) FROM mlces' ) dbGetQuery( con , 'SELECT claimant_relationship_to_policyholder , AVG( totpdchg ) FROM mlces GROUP BY claimant_relationship_to_policyholder' ) "],["national-beneficiary-survey-nbs.html", "National Beneficiary Survey (NBS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Beneficiary Survey (NBS) The principal microdata for U.S. disability researchers interested in Social Security program performance. One table with one row per respondent. A complex sample designed to generalize to Americans between age 18 and full retirement age, covered by either Social Security Disability Insurance (SSDI) or Supplemental Security Income (SSI). Released at irregular intervals, with 2004, 2005, 2006, 2010, 2015, 2017, and 2019 available. Administered by the Social Security Administration. Please skim before you begin: National Beneficiary Survey: Disability Statistics, 2015 National Beneficiary Survey - General Waves Round 7: User’s Guide This human-composed haiku or a bouquet of artificial intelligence-generated limericks # social safety net # poverty acrobatics # trap or trampoline Download, Import, Preparation Download and import the round 7 file: library(haven) zip_tf <- tempfile() zip_url <- "https://www.ssa.gov/disabilityresearch/documents/R7NBSPUF_STATA.zip" download.file( zip_url , zip_tf , mode = 'wb' ) nbs_tbl <- read_stata( zip_tf ) nbs_df <- data.frame( nbs_tbl ) names( nbs_df ) <- tolower( names( nbs_df ) ) nbs_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # nbs_fn <- file.path( path.expand( "~" ) , "NBS" , "this_file.rds" ) # saveRDS( nbs_df , file = nbs_fn , compress = FALSE ) Load the same object: # nbs_df <- readRDS( nbs_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) # representative beneficiary sample nbs_design <- svydesign( id = ~ r7_a_psu_pub , strata = ~ r7_a_strata , weights = ~ r7_wtr7_ben , data = subset( nbs_df , r7_wtr7_ben > 0 ) ) # cross-sectional successful worker sample nbs_design <- svydesign( id = ~ r7_a_psu_pub , strata = ~ r7_a_strata , weights = ~ r7_wtr7_cssws , data = subset( nbs_df , r7_wtr7_cssws > 0 ) ) # longitudinal successful worker sample lngsws_design <- svydesign( id = ~ r7_a_psu_pub , strata = ~ r7_a_strata , weights = ~ r7_wtr7_lngsws , data = subset( nbs_df , r7_wtr7_lngsws > 0 ) ) Variable Recoding Add new columns to the data set: nbs_design <- update( nbs_design , male = as.numeric( r7_orgsampinfo_sex == 1 ) , age_categories = factor( r7_c_intage_pub , labels = c( "18-25" , "26-40" , "41-55" , "56 and older" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nbs_design , "sampling" ) != 0 ) svyby( ~ one , ~ age_categories , nbs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nbs_design ) svyby( ~ one , ~ age_categories , nbs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) svyby( ~ r7_n_totssbenlastmnth_pub , ~ age_categories , nbs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ r7_c_hhsize_pub , nbs_design , na.rm = TRUE ) svyby( ~ r7_c_hhsize_pub , ~ age_categories , nbs_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) svyby( ~ r7_n_totssbenlastmnth_pub , ~ age_categories , nbs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ r7_c_hhsize_pub , nbs_design , na.rm = TRUE ) svyby( ~ r7_c_hhsize_pub , ~ age_categories , nbs_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ r7_n_totssbenlastmnth_pub , nbs_design , 0.5 , na.rm = TRUE ) svyby( ~ r7_n_totssbenlastmnth_pub , ~ age_categories , nbs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ r7_n_ssilastmnth_pub , denominator = ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) Subsetting Restrict the survey design to currently covered by Medicare: sub_nbs_design <- subset( nbs_design , r7_c_curmedicare == 1 ) Calculate the mean (average) of this subset: svymean( ~ r7_n_totssbenlastmnth_pub , sub_nbs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ r7_n_totssbenlastmnth_pub , ~ age_categories , nbs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nbs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ male , nbs_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( r7_n_totssbenlastmnth_pub ~ male , nbs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ male + r7_c_hhsize_pub , nbs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( r7_n_totssbenlastmnth_pub ~ male + r7_c_hhsize_pub , nbs_design ) summary( glm_result ) Replication Example This example matches the percentages and t-tests from the final ten rows of Exhibit 4: ex_4 <- data.frame( variable_label = c( 'coping with stress' , 'concentrating' , 'getting around outside of the home' , 'shopping for personal items' , 'preparing meals' , 'getting into or out of bed' , 'bathing or dressing' , 'getting along with others' , 'getting around inside the house' , 'eating' ) , variable_name = c( "r3_i60_i" , "r3_i59_i" , "r3_i47_i" , "r3_i53_i" , "r3_i55_i" , "r3_i49_i" , "r3_i51_i" , "r3_i61_i" , "r3_i45_i" , "r3_i57_i" ) , overall = c( 61 , 58 , 47 , 39 , 37 , 34 , 30 , 27 , 23 , 14 ) , di_only = c( 60 , 54 , 47 , 36 , 35 , 36 , 30 , 23 , 24 , 13 ) , concurrent = c( 63 , 63 , 47 , 43 , 41 , 34 , 33 , 31 , 23 , 15 ) , concurrent_vs_di = c( F , T , F , F , F , F , F , T , F , F ) , ssi = c( 61 , 62 , 47 , 40 , 39 , 33 , 29 , 31 , 22 , 15 ) , ssi_vs_di = c( F , T , F , F , F , F , F , T , F , F ) ) Download, import, and recode the round 3 file: r3_tf <- tempfile() r3_url <- "https://www.ssa.gov/disabilityresearch/documents/nbsr3pufstata.zip" download.file( r3_url , r3_tf , mode = 'wb' ) r3_tbl <- read_stata( r3_tf ) r3_df <- data.frame( r3_tbl ) names( r3_df ) <- tolower( names( r3_df ) ) r3_design <- svydesign( id = ~ r3_a_psu_pub , strata = ~ r3_a_strata , weights = ~ r3_wtr3_ben , data = subset( r3_df , r3_wtr3_ben > 0 ) ) r3_design <- update( r3_design , benefit_type = factor( r3_orgsampinfo_bstatus , levels = c( 2 , 3 , 1 ) , labels = c( 'di_only' , 'concurrent' , 'ssi' ) ) ) Calculate the final ten rows of exhibit 4 and confirm each statistics and t-test matches: for( i in seq( nrow( ex_4 ) ) ){ this_formula <- as.formula( paste( "~" , ex_4[ i , 'variable_name' ] ) ) overall_percent <- svymean( this_formula , r3_design ) stopifnot( 100 * round( coef( overall_percent ) , 2 ) == ex_4[ i , 'overall_percent' ] ) benefit_percent <- svyby( this_formula , ~ benefit_type , r3_design , svymean ) stopifnot( all.equal( 100 * as.numeric( round( coef( benefit_percent ) , 2 ) ) , as.numeric( ex_4[ i , c( 'di_only' , 'concurrent' , 'ssi' ) ] ) ) ) ttest_formula <- as.formula( paste( ex_4[ i , 'variable_name' ] , "~ benefit_type" ) ) di_only_con_design <- subset( r3_design , benefit_type %in% c( 'di_only' , 'concurrent' ) ) con_ttest <- svyttest( ttest_formula , di_only_con_design ) stopifnot( all.equal( as.logical( con_ttest$p.value < 0.05 ) , as.logical( ex_4[ i , 'concurrent_vs_di' ] ) ) ) di_only_ssi_design <- subset( r3_design , benefit_type %in% c( 'di_only' , 'ssi' ) ) ssi_ttest <- svyttest( ttest_formula , di_only_ssi_design ) stopifnot( all.equal( as.logical( ssi_ttest$p.value < 0.05 ) , as.logical( ex_4[ i , 'ssi_vs_di' ] ) ) ) } Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NBS users, this code replicates previously-presented examples: library(srvyr) nbs_srvyr_design <- as_survey( nbs_design ) Calculate the mean (average) of a linear variable, overall and by groups: nbs_srvyr_design %>% summarize( mean = survey_mean( r7_n_totssbenlastmnth_pub , na.rm = TRUE ) ) nbs_srvyr_design %>% group_by( age_categories ) %>% summarize( mean = survey_mean( r7_n_totssbenlastmnth_pub , na.rm = TRUE ) ) "],["national-financial-capability-study-nfcs.html", "National Financial Capability Study (NFCS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Financial Capability Study (NFCS) A study of financial knowledge and behavior, like making ends meet, planning ahead, managing assets. One state-by-state survey table with one row per sampled respondent, a separate investor survey. An online non-probability sample of U.S. adults (18+) calibrated to the American Community Survey. Released triennially since 2009. Funded by the FINRA Investor Education Foundation and conducted by FGS Global. Please skim before you begin: 2021 National Financial Capability Study: State-by-State Survey Methodology Financial Capability Insights: What the NFCS Reveals This human-composed haiku or a bouquet of artificial intelligence-generated limericks # lady madonna # laid bank balance goose egg, loves # gold unrequited Download, Import, Preparation Download and import the latest state-by-state microdata: library(haven) zip_tf <- tempfile() zip_url <- 'https://finrafoundation.org/sites/finrafoundation/files/2021-SxS-Data-and-Data-Info.zip' download.file( zip_url , zip_tf , mode = 'wb' ) unzipped_files <- unzip( zip_tf , exdir = tempdir() ) stata_fn <- grep( "\\\\.dta$" , unzipped_files , value = TRUE ) nfcs_tbl <- read_dta( stata_fn ) nfcs_df <- data.frame( nfcs_tbl ) names( nfcs_df ) <- tolower( names( nfcs_df ) ) Add a column of all ones, add labels to state names, add labels to the rainy day fund question: nfcs_df[ , 'one' ] <- 1 nfcs_df[ , 'state_name' ] <- factor( nfcs_df[ , 'stateq' ] , levels = 1:51 , labels = sort( c( 'District of Columbia' , state.name ) ) ) nfcs_df[ , 'rainy_day_fund' ] <- factor( nfcs_df[ , 'j5' ] , levels = c( 1 , 2 , 98 , 99 ) , labels = c( 'Yes' , 'No' , "Don't Know" , "Prefer not to say" ) ) Save locally   Save the object at any point: # nfcs_fn <- file.path( path.expand( "~" ) , "NFCS" , "this_file.rds" ) # saveRDS( nfcs_df , file = nfcs_fn , compress = FALSE ) Load the same object: # nfcs_df <- readRDS( nfcs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) nfcs_design <- svydesign( ~ 1 , data = nfcs_df , weights = ~ wgt_n2 ) divison_design <- svydesign( ~ 1 , data = nfcs_df , weights = ~ wgt_d2 ) state_design <- svydesign( ~ 1 , data = nfcs_df , weights = ~ wgt_s3 ) Variable Recoding Add new columns to the data set: nfcs_design <- update( nfcs_design , satisfaction_w_finances = ifelse( j1 > 10 , NA , j1 ) , risk_taking = ifelse( j2 > 10 , NA , j2 ) , difficult_to_pay_bills = factor( j4 , levels = c( 1 , 2 , 3 , 98 , 99 ) , labels = c( 'Very difficult' , 'Somewhat difficult' , 'Not at all difficult' , "Don't know" , 'Prefer not to say' ) ) , spending_vs_income = factor( j3 , levels = c( 1 , 2 , 3 , 98 , 99 ) , labels = c( 'Spending less than income' , 'Spending more than income' , 'Spending about equal to income' , "Don't know" , 'Prefer not to say' ) ) , unpaid_medical_bills = ifelse( g20 > 2 , NA , as.numeric( g20 == 1 ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nfcs_design , "sampling" ) != 0 ) svyby( ~ one , ~ spending_vs_income , nfcs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nfcs_design ) svyby( ~ one , ~ spending_vs_income , nfcs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE ) svyby( ~ satisfaction_w_finances , ~ spending_vs_income , nfcs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ difficult_to_pay_bills , nfcs_design ) svyby( ~ difficult_to_pay_bills , ~ spending_vs_income , nfcs_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE ) svyby( ~ satisfaction_w_finances , ~ spending_vs_income , nfcs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ difficult_to_pay_bills , nfcs_design ) svyby( ~ difficult_to_pay_bills , ~ spending_vs_income , nfcs_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ satisfaction_w_finances , nfcs_design , 0.5 , na.rm = TRUE ) svyby( ~ satisfaction_w_finances , ~ spending_vs_income , nfcs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ satisfaction_w_finances , denominator = ~ risk_taking , nfcs_design , na.rm = TRUE ) Subsetting Restrict the survey design to persons receiving pandemic-related stimulus payment: sub_nfcs_design <- subset( nfcs_design , j50 == 1 ) Calculate the mean (average) of this subset: svymean( ~ satisfaction_w_finances , sub_nfcs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ satisfaction_w_finances , ~ spending_vs_income , nfcs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nfcs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ unpaid_medical_bills , nfcs_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( satisfaction_w_finances ~ unpaid_medical_bills , nfcs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ unpaid_medical_bills + difficult_to_pay_bills , nfcs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( satisfaction_w_finances ~ unpaid_medical_bills + difficult_to_pay_bills , nfcs_design ) summary( glm_result ) Replication Example This example matches the unweighted count shown on PDF page 4: stopifnot( nrow( nfcs_df ) == 27118 ) This example matches the PDF page 7 estimate that 53% have three months of rainy day funds: national_rainy_day <- svymean( ~ rainy_day_fund , nfcs_design ) stopifnot( round( coef( national_rainy_day )[ 'rainy_day_fundYes' ] , 2 ) == 0.53 ) This example matches counts and rainy day estimates from The Geography of Financial Capability: state_counts <- svyby( ~ one , ~ state_name , state_design , unwtd.count ) stopifnot( state_counts[ 'California' , 'counts' ] == 1252 ) stopifnot( state_counts[ 'Missouri' , 'counts' ] == 501 ) stopifnot( state_counts[ 'Oregon' , 'counts' ] == 1261 ) state_rainy_day <- svyby( ~ rainy_day_fund , ~ state_name , state_design , svymean ) stopifnot( round( state_rainy_day[ 'California' , 'rainy_day_fundYes' ] , 2 ) == 0.57 ) stopifnot( round( state_rainy_day[ 'Missouri' , 'rainy_day_fundYes' ] , 2 ) == 0.51 ) stopifnot( round( state_rainy_day[ 'Oregon' , 'rainy_day_fundYes' ] , 2 ) == 0.52 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NFCS users, this code replicates previously-presented examples: library(srvyr) nfcs_srvyr_design <- as_survey( nfcs_design ) Calculate the mean (average) of a linear variable, overall and by groups: nfcs_srvyr_design %>% summarize( mean = survey_mean( satisfaction_w_finances , na.rm = TRUE ) ) nfcs_srvyr_design %>% group_by( spending_vs_income ) %>% summarize( mean = survey_mean( satisfaction_w_finances , na.rm = TRUE ) ) "],["national-health-and-nutrition-examination-survey-nhanes.html", "National Health and Nutrition Examination Survey (NHANES) Download, Import, Preparation Analysis Examples with the survey library   Direct Method of Age-Adjustment Replication Example Analysis Examples with srvyr  ", " National Health and Nutrition Examination Survey (NHANES) Doctors and dentists accompany survey interviewers in a mobile medical center that travels the country. While survey researchers read the questionnaires, medical professionals administer laboratory tests and conduct a full medical examination. The blood work and in-person check-up allow epidemiologists to answer questions like, “how many people have diabetes but don’t know they have diabetes?” Many tables containing information from the various examinations, generally one row per respondent. A complex sample survey designed to generalize to the civilian non-institutionalized U.S. population. Released biennially since 1999-2000. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: About the National Health and Nutrition Examination Survey NHANES Tutorials This human-composed haiku or a bouquet of artificial intelligence-generated limericks # doctor, dentist, labs # mobile examination #vanlife interviews Download, Import, Preparation Download and import the demographics (demo) and total cholesterol laboratory (tchol) data: library(haven) nhanes_2015_2016_demo_url <- "https://wwwn.cdc.gov/Nchs/Nhanes/2015-2016/DEMO_I.XPT" nhanes_2017_2018_demo_url <- "https://wwwn.cdc.gov/Nchs/Nhanes/2017-2018/DEMO_J.XPT" nhanes_2015_2016_tchol_url <- "https://wwwn.cdc.gov/Nchs/Nhanes/2015-2016/TCHOL_I.XPT" nhanes_2017_2018_tchol_url <- "https://wwwn.cdc.gov/Nchs/Nhanes/2017-2018/TCHOL_J.XPT" nhanes_2015_2016_demo_tbl <- read_xpt( nhanes_2015_2016_demo_url ) nhanes_2017_2018_demo_tbl <- read_xpt( nhanes_2017_2018_demo_url ) nhanes_2015_2016_tchol_tbl <- read_xpt( nhanes_2015_2016_tchol_url ) nhanes_2017_2018_tchol_tbl <- read_xpt( nhanes_2017_2018_tchol_url ) nhanes_2015_2016_demo_df <- data.frame( nhanes_2015_2016_demo_tbl ) nhanes_2017_2018_demo_df <- data.frame( nhanes_2017_2018_demo_tbl ) nhanes_2015_2016_tchol_df <- data.frame( nhanes_2015_2016_tchol_tbl ) nhanes_2017_2018_tchol_df <- data.frame( nhanes_2017_2018_tchol_tbl ) Specify which variables to keep from both the demo and tchol data files, then stack the four years: demo_vars <- c( # unique person identifier (merge variable) "SEQN" , # the two-year interviewed + MEC examined weight "WTMEC2YR" , # note that this is a special weight for only # individuals who took the mobile examination center (MEC) exam # there is one other weight available - WTINT2YR - # that should be used when MEC variables are not part of the analysis # interviewed only or interviewed + MEC "RIDSTATR" , # primary sampling unit varaible, used in complex design "SDMVPSU" , # strata variable, used in complex design "SDMVSTRA" , # race / ethnicity "RIDRETH3" , # age "RIDAGEYR" , # gender "RIAGENDR" , # pregnant at interview "RIDEXPRG" ) nhanes_2015_2018_demo_df <- rbind( nhanes_2015_2016_demo_df[ , demo_vars ] , nhanes_2017_2018_demo_df[ , demo_vars ] ) tchol_vars <- c( # unique person identifier (merge variable) "SEQN" , # laboratory total cholesterol variable # https://wwwn.cdc.gov/Nchs/Nhanes/2017-2018/TCHOL_J.htm "LBXTC" ) nhanes_2015_2018_tchol_df <- rbind( nhanes_2015_2016_tchol_df[ , tchol_vars ] , nhanes_2017_2018_tchol_df[ , tchol_vars ] ) Merge the two pooled datasets, limit the data.frame to mobile examination component respondents: nhanes_full_df <- merge( nhanes_2015_2018_demo_df , nhanes_2015_2018_tchol_df , all = TRUE ) names( nhanes_full_df ) <- tolower( names( nhanes_full_df ) ) nhanes_df <- subset( nhanes_full_df , ridstatr %in% 2 ) Scale the mobile examination component two-year weight to generalize to the pooled, four year period: nhanes_df[ , 'wtmec4yr' ] <- nhanes_df[ , 'wtmec2yr' ] / 2 Save locally   Save the object at any point: # nhanes_fn <- file.path( path.expand( "~" ) , "NHANES" , "this_file.rds" ) # saveRDS( nhanes_df , file = nhanes_fn , compress = FALSE ) Load the same object: # nhanes_df <- readRDS( nhanes_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) nhanes_design <- svydesign( id = ~ sdmvpsu , strata = ~ sdmvstra , nest = TRUE , weights = ~ wtmec4yr , data = nhanes_df ) Variable Recoding Add new columns to the data set: nhanes_design <- update( nhanes_design , one = 1 , # define high total cholesterol as 1 if mg/dL is at or above 240 and zero otherwise. hi_tchol = ifelse( lbxtc >= 240 , 1 , 0 ) , gender = factor( riagendr , levels = 1:2 , labels = c( 'male' , 'female' ) ) , age_categories = factor( 1 + findInterval( ridageyr , c( 20 , 40 , 60 ) ) , levels = 1:4 , labels = c( "0-19" , "20-39" , "40-59" , "60+" ) ) , # recode the ridreth3 variable as: # mexican american and other hispanic -> 4 # non-hispanic white -> 1 # non-hispanic black -> 2 # non-hispanic asian -> 3 # other race including multi-racial -> 5 race_ethnicity = factor( c( 4 , 4 , 1 , 2 , NA , 3 , 5 )[ ridreth3 ] , levels = 1:5 , labels = c( 'nh white' , 'nh black' , 'nh asian' , 'hispanic' , 'other' ) ) , pregnant_at_interview = ifelse( ridexprg %in% 1:2 , as.numeric( ridexprg == 1 ) , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nhanes_design , "sampling" ) != 0 ) svyby( ~ one , ~ race_ethnicity , nhanes_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nhanes_design ) svyby( ~ one , ~ race_ethnicity , nhanes_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ lbxtc , nhanes_design , na.rm = TRUE ) svyby( ~ lbxtc , ~ race_ethnicity , nhanes_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ riagendr , nhanes_design ) svyby( ~ riagendr , ~ race_ethnicity , nhanes_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ lbxtc , nhanes_design , na.rm = TRUE ) svyby( ~ lbxtc , ~ race_ethnicity , nhanes_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ riagendr , nhanes_design ) svyby( ~ riagendr , ~ race_ethnicity , nhanes_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ lbxtc , nhanes_design , 0.5 , na.rm = TRUE ) svyby( ~ lbxtc , ~ race_ethnicity , nhanes_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ lbxtc , denominator = ~ ridageyr , nhanes_design , na.rm = TRUE ) Subsetting Restrict the survey design to respondents aged 60 or older: sub_nhanes_design <- subset( nhanes_design , age_categories == "60+" ) Calculate the mean (average) of this subset: svymean( ~ lbxtc , sub_nhanes_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ lbxtc , nhanes_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ lbxtc , ~ race_ethnicity , nhanes_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nhanes_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ lbxtc , nhanes_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ lbxtc , nhanes_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ lbxtc , nhanes_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ pregnant_at_interview , nhanes_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( lbxtc ~ pregnant_at_interview , nhanes_design ) Perform a chi-squared test of association for survey data: svychisq( ~ pregnant_at_interview + riagendr , nhanes_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( lbxtc ~ pregnant_at_interview + riagendr , nhanes_design ) summary( glm_result ) Direct Method of Age-Adjustment Replication Example This example matches the total cholesterol statistics and standard errors in Table 1 from Data Brief 363: Match the crude estimates in the footnote and also in the unadjusted age categories: crude_overall <- svymean( ~ hi_tchol , subset( nhanes_design , ridageyr >= 20 ) , na.rm = TRUE ) stopifnot( round( coef( crude_overall ) , 3 ) == 0.115 ) crude_by_gender <- svyby( ~ hi_tchol , ~ gender , subset( nhanes_design , ridageyr >= 20 ) , svymean , na.rm = TRUE ) stopifnot( round( coef( crude_by_gender )[ 1 ] , 3 ) == 0.103 ) stopifnot( round( coef( crude_by_gender )[ 2 ] , 3 ) == 0.126 ) crude_by_age <- svyby( ~ hi_tchol , ~ age_categories , subset( nhanes_design , ridageyr >= 20 ) , svymean , na.rm = TRUE ) stopifnot( round( coef( crude_by_age )[ 1 ] , 3 ) == 0.075 ) stopifnot( round( coef( crude_by_age )[ 2 ] , 3 ) == 0.157 ) stopifnot( round( coef( crude_by_age )[ 3 ] , 3 ) == 0.114 ) stopifnot( round( SE( crude_by_age )[ 1 ] , 3 ) == 0.005 ) stopifnot( round( SE( crude_by_age )[ 2 ] , 3 ) == 0.011 ) stopifnot( round( SE( crude_by_age )[ 3 ] , 3 ) == 0.008 ) Sum up 2000 Census totals based on the age groupings specified in footnote: pop_by_age <- data.frame( age_categories = c( "0-19" , "20-39" , "40-59" , "60+" ) , Freq = c( 78782657 , 77670618 , 72816615 , 45363752 ) ) Create a design with the nationwide population stratified to the above census counts: nhanes_age_adjusted <- postStratify( subset( nhanes_design , !is.na( hi_tchol ) ) , ~ age_categories , pop_by_age ) Match the overall adjusted estimates: results_overall <- svymean( ~ hi_tchol , subset( nhanes_age_adjusted , ridageyr >= 20 ) , na.rm = TRUE ) stopifnot( round( coef( results_overall ) , 3 ) == 0.114 ) stopifnot( round( SE( results_overall ) , 3 ) == 0.006 ) Create a design stratified to census counts broken out by gender, then match those estimates: nhanes_by_gender <- svystandardize( nhanes_design , by = ~ age_categories , # stratification variable over = ~ gender , # break out variable population = pop_by_age , # data.frame containing census populations excluding.missing = ~ hi_tchol # analysis variable of interest ) results_by_gender <- svyby( ~ hi_tchol , ~ gender , subset( nhanes_by_gender , ridageyr >= 20 ) , svymean , na.rm=TRUE ) stopifnot( round( coef( results_by_gender )[ 1 ] , 3 ) == 0.105 ) stopifnot( round( coef( results_by_gender )[ 2 ] , 3 ) == 0.121 ) stopifnot( round( SE( results_by_gender )[ 1 ] , 3 ) == 0.007 ) stopifnot( round( SE( results_by_gender )[ 2 ] , 3 ) == 0.008 ) Create a design stratified to census counts broken out by race/ethnicity, then match those estimates: nhanes_by_race <- svystandardize( nhanes_design , by = ~ age_categories , # stratification variable over = ~ race_ethnicity , # break out variable population = pop_by_age , # data.frame containing census populations excluding.missing = ~ hi_tchol # analysis variable of interest ) results_by_race_ethnicity <- svyby( ~ hi_tchol , ~ race_ethnicity , design = subset( nhanes_by_race , ridageyr >= 20 ) , svymean , na.rm=TRUE ) stopifnot( round( coef( results_by_race_ethnicity )[ 1 ] , 3 ) == 0.117 ) stopifnot( round( coef( results_by_race_ethnicity )[ 2 ] , 3 ) == 0.100 ) stopifnot( round( coef( results_by_race_ethnicity )[ 3 ] , 3 ) == 0.116 ) stopifnot( round( coef( results_by_race_ethnicity )[ 4 ] , 3 ) == 0.109 ) stopifnot( round( SE( results_by_race_ethnicity )[ 1 ] , 3 ) == 0.007 ) stopifnot( round( SE( results_by_race_ethnicity )[ 2 ] , 3 ) == 0.009 ) stopifnot( round( SE( results_by_race_ethnicity )[ 3 ] , 3 ) == 0.011 ) stopifnot( round( SE( results_by_race_ethnicity )[ 4 ] , 3 ) == 0.009 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NHANES users, this code replicates previously-presented examples: library(srvyr) nhanes_srvyr_design <- as_survey( nhanes_design ) Calculate the mean (average) of a linear variable, overall and by groups: nhanes_srvyr_design %>% summarize( mean = survey_mean( lbxtc , na.rm = TRUE ) ) nhanes_srvyr_design %>% group_by( race_ethnicity ) %>% summarize( mean = survey_mean( lbxtc , na.rm = TRUE ) ) "],["national-health-interview-survey-nhis.html", "National Health Interview Survey (NHIS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " National Health Interview Survey (NHIS) America’s most detailed household survey of health status and medical experience. One table with one row per sampled adult (18+) within each sampled household, one table with one row per sample child (when available, same family not required), multiply-imputed income tables. A complex sample survey designed to generalize to the U.S. civilian non-institutionalized population. Released annually since 1963, the most recent major re-design in 2019. Conducted by the National Center for Health Statistics at the Centers for Disease Control. Please skim before you begin: 2021 Survey Description Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # excellent health poor # wealth. "sup, doc?" bugs, daft bills, free # laughs best medicine Download, Import, Preparation Define a function to download, unzip, and import each comma-separated value file: nhis_csv_import <- function( this_url ){ this_tf <- tempfile() download.file( this_url , this_tf , mode = 'wb' ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) this_csv <- grep( '\\\\.csv$' , unzipped_files , value = TRUE ) this_df <- read.csv( this_csv ) file.remove( c( this_tf , unzipped_files ) ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the sample adult interview and imputed income files: nhis_df <- nhis_csv_import( "https://ftp.cdc.gov/pub/Health_Statistics/NCHS/Datasets/NHIS/2021/adult21csv.zip" ) imputed_income_df <- nhis_csv_import( "https://ftp.cdc.gov/pub/Health_Statistics/NCHS/Datasets/NHIS/2021/adultinc21csv.zip" ) Save locally   Save the object at any point: # nhis_fn <- file.path( path.expand( "~" ) , "NHIS" , "this_file.rds" ) # saveRDS( nhis_df , file = nhis_fn , compress = FALSE ) Load the same object: # nhis_df <- readRDS( nhis_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: Reshape the imputed income data.frame into a list based on the implicate number: imputed_income_list <- split( imputed_income_df , imputed_income_df[ , 'impnum_a' ] ) Remove overlapping columns except the merge variable: variables_to_remove <- setdiff( intersect( names( nhis_df ) , names( imputed_income_df ) ) , 'hhx' ) nhis_df <- nhis_df[ , !( names( nhis_df ) %in% variables_to_remove ) ] Merge each implicate onto the sample adult table: nhis_list <- lapply( imputed_income_list , function( w ){ this_df <- merge( nhis_df , w ) stopifnot( nrow( this_df ) == nrow( nhis_df ) ) this_df } ) Define the design: library(survey) library(mitools) nhis_design <- svydesign( id = ~ ppsu , strata = ~ pstrat , nest = TRUE , weights = ~ wtfa_a , data = imputationList( nhis_list ) ) Variable Recoding Add new columns to the data set: nhis_design <- update( nhis_design , one = 1 , poverty_category = factor( findInterval( povrattc_a , c( 1 , 2 , 4 ) ) , labels = c( "below poverty" , "100-199%" , "200-399%" , "400%+" ) ) , fair_or_poor_reported_health = ifelse( phstat_a %in% 1:5 , as.numeric( phstat_a >= 4 ) , NA ) , sex_a = factor( sex_a , levels = 1:2 , labels = c( "male" , "female" ) ) , annual_premium_first_plan = ifelse( hicostr1_a > 40000 , NA , hicostr1_a ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: MIcombine( with( nhis_design , svyby( ~ one , ~ one , unwtd.count ) ) ) MIcombine( with( nhis_design , svyby( ~ one , ~ poverty_category , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: MIcombine( with( nhis_design , svytotal( ~ one ) ) ) MIcombine( with( nhis_design , svyby( ~ one , ~ poverty_category , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: MIcombine( with( nhis_design , svymean( ~ agep_a ) ) ) MIcombine( with( nhis_design , svyby( ~ agep_a , ~ poverty_category , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: MIcombine( with( nhis_design , svymean( ~ sex_a ) ) ) MIcombine( with( nhis_design , svyby( ~ sex_a , ~ poverty_category , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: MIcombine( with( nhis_design , svytotal( ~ agep_a ) ) ) MIcombine( with( nhis_design , svyby( ~ agep_a , ~ poverty_category , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: MIcombine( with( nhis_design , svytotal( ~ sex_a ) ) ) MIcombine( with( nhis_design , svyby( ~ sex_a , ~ poverty_category , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: MIcombine( with( nhis_design , svyquantile( ~ agep_a , 0.5 , se = TRUE ) ) ) MIcombine( with( nhis_design , svyby( ~ agep_a , ~ poverty_category , svyquantile , 0.5 , se = TRUE , ci = TRUE ) ) ) Estimate a ratio: MIcombine( with( nhis_design , svyratio( numerator = ~ annual_premium_first_plan , denominator = ~ agep_a , na.rm = TRUE ) ) ) Subsetting Restrict the survey design to uninsured: sub_nhis_design <- subset( nhis_design , notcov_a == 1 ) Calculate the mean (average) of this subset: MIcombine( with( sub_nhis_design , svymean( ~ agep_a ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- MIcombine( with( nhis_design , svymean( ~ agep_a ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- MIcombine( with( nhis_design , svyby( ~ agep_a , ~ poverty_category , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nhis_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: MIcombine( with( nhis_design , svyvar( ~ agep_a ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement MIcombine( with( nhis_design , svymean( ~ agep_a , deff = TRUE ) ) ) # SRS with replacement MIcombine( with( nhis_design , svymean( ~ agep_a , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ fair_or_poor_reported_health , nhis_design , # method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( agep_a ~ fair_or_poor_reported_health , nhis_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ fair_or_poor_reported_health + sex_a , nhis_design ) Perform a survey-weighted generalized linear model: glm_result <- MIcombine( with( nhis_design , svyglm( agep_a ~ fair_or_poor_reported_health + sex_a ) ) ) summary( glm_result ) Replication Example This example matches statistics and standard errors within 0.01% from Figure 3 of this Characteristics of Adults Aged 18–64 Who Did Not Take Medication as Prescribed to Reduce Costs Data Brief: results <- MIcombine( with( subset( nhis_design , agep_a < 65 ) , svyby( ~ as.numeric( rxsk12m_a == 1 | rxls12m_a == 1 | rxdl12m_a == 1 ) , ~ poverty_category , svymean , na.rm = TRUE ) ) ) stopifnot( all( as.numeric( round( coef( results ) , 3 ) ) == c( 0.145 , 0.138 , 0.099 , 0.039 ) ) ) stopifnot( all( as.numeric( round( SE( results ) , 5 ) ) - c( 0.0126 , 0.0098 , 0.0062 , 0.0031 ) < 0.0001 ) ) "],["national-household-travel-survey-nhts.html", "National Household Travel Survey (NHTS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Household Travel Survey (NHTS) The authoritative source on travel behavior, recording characteristics of people and vehicles of all modes. Four core linkable tables, with one record per household, person, trip, and vehicle, respectively. A complex sample survey designed to generalize to the civilian non-institutional U.S. population. Released every five to eight years since 1969, with a 2022 release expected in late 2023. Funded by the Federal Highway Administration, with data collected by Westat. Please skim before you begin: 2017 NHTS Data User Guide 2017 NHTS Weighting Report This human-composed haiku or a bouquet of artificial intelligence-generated limericks # commuter patterns, # truckin'. what a long strange trip # who went when where why Download, Import, Preparation Download and unzip each of the main 2017 files: library(haven) nhts_dl_uz <- function( this_url ){ tf <- tempfile() download.file( this_url , tf , mode = 'wb' ) unzip( tf , exdir = tempdir() ) } unzipped_survey_data <- nhts_dl_uz( "https://nhts.ornl.gov/assets/2016/download/sas.zip" ) unzipped_replicate_weights <- nhts_dl_uz( "https://nhts.ornl.gov/assets/2016/download/Replicates.zip" ) unzipped_trip_chains <- nhts_dl_uz( "https://nhts.ornl.gov/assets/2016/download/TripChain/TripChain17.zip" ) Import the tables containing one record per household, person, trip, and vehicle: nhts_import <- function( this_prefix , this_unzip ){ this_sas7bdat <- grep( paste0( this_prefix , "\\\\.sas7bdat$" ) , this_unzip , value = TRUE ) this_tbl <- read_sas( this_sas7bdat ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) this_df } hhpub_df <- nhts_import( "hhpub" , unzipped_survey_data ) perpub_df <- nhts_import( "perpub" , unzipped_survey_data ) trippub_df <- nhts_import( "trippub" , unzipped_survey_data ) vehpub_df <- nhts_import( "vehpub" , unzipped_survey_data ) hhwgt_df <- nhts_import( "hhwgt" , unzipped_replicate_weights ) perwgt_df <- nhts_import( "perwgt" , unzipped_replicate_weights ) Add a column of ones to three of those tables, then a column of non-missing mileage to the trips table: hhpub_df[ , 'one' ] <- 1 perpub_df[ , 'one' ] <- 1 trippub_df[ , 'one' ] <- 1 trippub_df[ !( trippub_df[ , 'trpmiles' ] %in% -9 ) , 'tripmiles_no_nines' ] <- trippub_df[ !( trippub_df[ , 'trpmiles' ] %in% -9 ) , 'trpmiles' ] Sum the total trip count and mileage to the person-level, both overall and restricted to walking only: trips_per_person <- with( trippub_df , aggregate( cbind( one , tripmiles_no_nines ) , list( houseid , personid ) , sum , na.rm = TRUE ) ) names( trips_per_person ) <- c( 'houseid' , 'personid' , 'trips_per_person' , 'miles_per_person' ) walks_per_person <- with( subset( trippub_df , trptrans == '01' ) , aggregate( cbind( one , tripmiles_no_nines ) , list( houseid , personid ) , sum , na.rm = TRUE ) ) names( walks_per_person ) <- c( 'houseid' , 'personid' , 'walks_per_person' , 'walk_miles_per_person' ) Merge these trip count and mileage values on to the person-level file, replacing non-matches with zero: nhts_df <- merge( perpub_df , trips_per_person , all.x = TRUE ) nhts_df[ is.na( nhts_df[ , 'trips_per_person' ] ) , 'trips_per_person' ] <- 0 nhts_df[ is.na( nhts_df[ , 'miles_per_person' ] ) , 'miles_per_person' ] <- 0 nhts_df <- merge( nhts_df , walks_per_person , all.x = TRUE ) nhts_df[ is.na( nhts_df[ , 'walks_per_person' ] ) , 'walks_per_person' ] <- 0 nhts_df[ is.na( nhts_df[ , 'walk_miles_per_person' ] ) , 'walk_miles_per_person' ] <- 0 stopifnot( nrow( nhts_df ) == nrow( perpub_df ) ) Save locally   Save the object at any point: # nhts_fn <- file.path( path.expand( "~" ) , "NHTS" , "this_file.rds" ) # saveRDS( nhts_df , file = nhts_fn , compress = FALSE ) Load the same object: # nhts_df <- readRDS( nhts_fn ) Survey Design Definition Construct a complex sample survey design: Sort both the one record per household and household replicate weights tables, then define the design: library(survey) hhpub_df <- hhpub_df[ order( hhpub_df[ , 'houseid' ] ) , ] hhwgt_df <- hhwgt_df[ order( hhwgt_df[ , 'houseid' ] ) , ] hh_design <- svrepdesign( weight = ~ wthhfin , repweights = hhwgt_df[ grep( 'wthhfin[0-9]' , names( hhwgt_df ) , value = TRUE ) ] , scale = 6 / 7 , rscales = 1 , type = 'JK1' , mse = TRUE , data = hhpub_df ) Sort both the one record per person and person replicate weights tables, then define the design: nhts_df <- nhts_df[ do.call( order , nhts_df[ , c( 'houseid' , 'personid' ) ] ) , ] perwgt_df <- perwgt_df[ do.call( order , perwgt_df[ , c( 'houseid' , 'personid' ) ] ) , ] nhts_design <- svrepdesign( weight = ~ wtperfin , repweights = perwgt_df[ grep( 'wtperfin[0-9]' , names( perwgt_df ) , value = TRUE ) ] , scale = 6 / 7 , rscales = rep( 1 , 98 ) , type = 'JK1' , mse = TRUE , data = nhts_df ) Sort both the one record per trip and person replicate weights tables, then define the design: trippub_df <- trippub_df[ do.call( order , trippub_df[ , c( 'houseid' , 'personid' ) ] ) , ] perwgt_df <- perwgt_df[ do.call( order , perwgt_df[ , c( 'houseid' , 'personid' ) ] ) , ] trip_design <- svrepdesign( weight = ~ wttrdfin , repweights = perwgt_df[ grep( 'wttrdfin[0-9]' , names( perwgt_df ) , value = TRUE ) ] , scale = 6 / 7 , rscales = 1 , type = 'JK1' , mse = TRUE , data = trippub_df ) Variable Recoding Add new columns to the data set: hh_design <- update( hh_design , hhsize_categories = factor( findInterval( hhsize , 1:4 ) , levels = 1:4 , labels = c( 1:3 , '4 or more' ) ) ) nhts_design <- update( nhts_design , urban_area = as.numeric( urbrur == '01' ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nhts_design , "sampling" ) != 0 ) svyby( ~ one , ~ r_sex_imp , nhts_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nhts_design ) svyby( ~ one , ~ r_sex_imp , nhts_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ miles_per_person , nhts_design ) svyby( ~ miles_per_person , ~ r_sex_imp , nhts_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ hhstate , nhts_design ) svyby( ~ hhstate , ~ r_sex_imp , nhts_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ miles_per_person , nhts_design ) svyby( ~ miles_per_person , ~ r_sex_imp , nhts_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ hhstate , nhts_design ) svyby( ~ hhstate , ~ r_sex_imp , nhts_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ miles_per_person , nhts_design , 0.5 ) svyby( ~ miles_per_person , ~ r_sex_imp , nhts_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ walk_miles_per_person , denominator = ~ miles_per_person , nhts_design ) Subsetting Restrict the survey design to ever cyclists: sub_nhts_design <- subset( nhts_design , nbiketrp > 0 ) Calculate the mean (average) of this subset: svymean( ~ miles_per_person , sub_nhts_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ miles_per_person , nhts_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ miles_per_person , ~ r_sex_imp , nhts_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nhts_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ miles_per_person , nhts_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ miles_per_person , nhts_design , deff = TRUE ) # SRS with replacement svymean( ~ miles_per_person , nhts_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ urban_area , nhts_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( miles_per_person ~ urban_area , nhts_design ) Perform a chi-squared test of association for survey data: svychisq( ~ urban_area + hhstate , nhts_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( miles_per_person ~ urban_area + hhstate , nhts_design ) summary( glm_result ) Replication Example This example matches the 2017 rows from Summary of Travel Trends Table 1a: hhsize_counts <- svytotal( ~ hhsize_categories , hh_design ) stopifnot( all( round( coef( hhsize_counts ) / 1000 , 0 ) == c( 32952 , 40056 , 18521 , 26679 ) ) ) hhsize_ci <- confint( hhsize_counts , df = ncol( hh_design$repweights ) ) hhsize_moe <- hhsize_ci[ , 2 ] - coef( hhsize_counts ) stopifnot( all( round( hhsize_moe / 1000 , 0 ) == c( 0 , 0 , 97 , 97 ) ) ) This example matches 2017 NHTS Westat project co-author’s workshop slide 38: unwtd_n <- with( nhts_df , tapply( trips_per_person , worker , sum ) ) stopifnot( all( unwtd_n == c( 79295 , 28 , 497944 , 346305 ) ) ) surveyed_n <- with( nhts_df , tapply( trips_per_person , worker , mean ) ) stopifnot( all( round( surveyed_n , 2 ) == c( 2.84 , 1.65 , 3.88 , 3.21 ) ) ) this_mean <- svyby( ~ trips_per_person , ~ worker , nhts_design , svymean ) stopifnot( round( coef( this_mean ) , 2 ) == c( 2.78 , 1.28 , 3.77 , 3.01 ) ) this_ci <- confint( this_mean , df = ncol( nhts_design$repweights ) ) this_moe <- this_ci[ , 2 ] - coef( this_mean ) stopifnot( all( round( this_moe , 2 ) == c( 0.06 , 2.21 , 0.03 , 0.06 ) ) ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NHTS users, this code replicates previously-presented examples: library(srvyr) nhts_srvyr_design <- as_survey( nhts_design ) Calculate the mean (average) of a linear variable, overall and by groups: nhts_srvyr_design %>% summarize( mean = survey_mean( miles_per_person ) ) nhts_srvyr_design %>% group_by( r_sex_imp ) %>% summarize( mean = survey_mean( miles_per_person ) ) "],["national-immunization-survey-nis.html", "National Immunization Survey (NIS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Immunization Survey (NIS) The vaccination coverage rate tracker for national, state, and selected local areas. One table with one row per sampled toddler. A complex sample survey designed to generalize to children aged 19-35 months in the United States. Released annually since 1995, plus an adolescent (13-17 years) sample since 2008. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: About NIS National Immunization Survey-Child: A User’s Guide for the 2021 Public-Use Data File This human-composed haiku or a bouquet of artificial intelligence-generated limericks # i hear babies cry # protesting lungs of iron # a wonderful world Download, Import, Preparation Download the fixed-width file: dat_tf <- tempfile() dat_url <- "https://ftp.cdc.gov/pub/Vaccines_NIS/NISPUF21.DAT" download.file( dat_url , dat_tf , mode = 'wb' ) Edit then execute the import script provided by the CDC: library(Hmisc) r_tf <- tempfile() r_script_url <- "https://ftp.cdc.gov/pub/Vaccines_NIS/NISPUF21.R" r_input_lines <- readLines( r_script_url ) # do not let the script do the save() r_input_lines <- gsub( "^save\\\\(" , "# save(" , r_input_lines ) # redirect the path to the flat file to the local save location of `dat_tf` r_input_lines <- gsub( '\\\\"path\\\\-to\\\\-file\\\\/(.*)\\\\.DAT\\\\"' , "dat_tf" , r_input_lines ) # save the edited script locally writeLines( r_input_lines , r_tf ) # run the edited script source( r_tf , echo = TRUE ) # rename the resultant data.frame object nis_df <- NISPUF21 names( nis_df ) <- tolower( names( nis_df ) ) nis_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # nis_fn <- file.path( path.expand( "~" ) , "NIS" , "this_file.rds" ) # saveRDS( nis_df , file = nis_fn , compress = FALSE ) Load the same object: # nis_df <- readRDS( nis_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) nis_design <- svydesign( id = ~ seqnumhh , strata = ~ stratum , weights = ~ provwt_c , data = subset( nis_df , provwt_c > 0 ) ) Variable Recoding Add new columns to the data set: nis_design <- update( nis_design , first_fed_formula = ifelse( bf_formr20 %in% 888 , NA , bf_formr20 ) , dtap_3p = as.numeric( ( p_numdah >= 3 ) | ( p_numdhi >= 3 ) | ( p_numdih >= 3 ) | ( p_numdta >= 3 ) | ( p_numdtp >= 3 ) ) , dtap_4p = as.numeric( ( p_numdah >= 4 ) | ( p_numdhi >= 4 ) | ( p_numdih >= 4 ) | ( p_numdta >= 4 ) | ( p_numdtp >= 4 ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nis_design , "sampling" ) != 0 ) svyby( ~ one , ~ state , nis_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nis_design ) svyby( ~ one , ~ state , nis_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ first_fed_formula , nis_design , na.rm = TRUE ) svyby( ~ first_fed_formula , ~ state , nis_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ sex , nis_design , na.rm = TRUE ) svyby( ~ sex , ~ state , nis_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ first_fed_formula , nis_design , na.rm = TRUE ) svyby( ~ first_fed_formula , ~ state , nis_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ sex , nis_design , na.rm = TRUE ) svyby( ~ sex , ~ state , nis_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ first_fed_formula , nis_design , 0.5 , na.rm = TRUE ) svyby( ~ first_fed_formula , ~ state , nis_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ bf_exclr06 , denominator = ~ bf_endr06 , nis_design , na.rm = TRUE ) Subsetting Restrict the survey design to toddlers up to date on polio shots: sub_nis_design <- subset( nis_design , p_utdpol == 1 ) Calculate the mean (average) of this subset: svymean( ~ first_fed_formula , sub_nis_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ first_fed_formula , nis_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ first_fed_formula , ~ state , nis_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nis_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ first_fed_formula , nis_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ first_fed_formula , nis_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ first_fed_formula , nis_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ dtap_3p , nis_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( first_fed_formula ~ dtap_3p , nis_design ) Perform a chi-squared test of association for survey data: svychisq( ~ dtap_3p + sex , nis_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( first_fed_formula ~ dtap_3p + sex , nis_design ) summary( glm_result ) Replication Example This example matches the statistics and standard errors from Data User’s Guide Table 4: results <- svyby( ~ p_utd431h314_rout_s , ~ raceethk , nis_design , svymean ) coefficients <- results[ , "p_utd431h314_rout_sUTD" , drop = FALSE ] standard_errors <- results[ , "se.p_utd431h314_rout_sUTD" , drop = FALSE ] stopifnot( round( coefficients[ "HISPANIC" , ] , 3 ) == .711 ) stopifnot( round( coefficients[ "NON-HISPANIC WHITE ONLY" , ] , 3 ) == .742 ) stopifnot( round( coefficients[ "NON-HISPANIC BLACK ONLY" , ] , 3 ) == .647 ) stopifnot( round( standard_errors[ "HISPANIC" , ] , 3 ) == .015 ) stopifnot( round( standard_errors[ "NON-HISPANIC WHITE ONLY" , ] , 3 ) == .009 ) stopifnot( round( standard_errors[ "NON-HISPANIC BLACK ONLY" , ] , 3 ) == .022 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NIS users, this code replicates previously-presented examples: library(srvyr) nis_srvyr_design <- as_survey( nis_design ) Calculate the mean (average) of a linear variable, overall and by groups: nis_srvyr_design %>% summarize( mean = survey_mean( first_fed_formula , na.rm = TRUE ) ) nis_srvyr_design %>% group_by( state ) %>% summarize( mean = survey_mean( first_fed_formula , na.rm = TRUE ) ) "],["national-plan-and-provider-enumeration-system-nppes.html", "National Plan and Provider Enumeration System (NPPES) Download, Import, Preparation Analysis Examples with base R   Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " National Plan and Provider Enumeration System (NPPES) The registry of every medical practitioner actively operating in the United States healthcare industry. A single large table with one row per enumerated health care provider. A census of individuals and organizations that bill for medical services in the United States. Updated weekly with new providers. Maintained by the United States Centers for Medicare & Medicaid Services (CMS) Please skim before you begin: NPI: What You Need To Know Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # how many doctors # ranked sergeant, last name pepper # practice in the states? Download, Import, Preparation Download and import the national file: library(readr) tf <- tempfile() npi_datapage <- readLines( "http://download.cms.gov/nppes/NPI_Files.html" ) latest_files <- grep( 'NPPES_Data_Dissemination_' , npi_datapage , value = TRUE ) latest_files <- latest_files[ !grepl( 'Weekly Update' , latest_files ) ] this_url <- paste0( "http://download.cms.gov/nppes/", gsub( "(.*)(NPPES_Data_Dissemination_.*\\\\.zip)(.*)$", "\\\\2", latest_files ) ) download.file( this_url , tf , mode = 'wb' ) npi_files <- unzip( tf , exdir = tempdir() ) npi_filepath <- grep( "npidata_pfile_20050523-([0-9]+)\\\\.csv" , npi_files , value = TRUE ) column_names <- names( read.csv( npi_filepath , nrow = 1 )[ FALSE , , ] ) column_names <- gsub( "\\\\." , "_" , tolower( column_names ) ) column_types <- ifelse( grepl( "code" , column_names ) & !grepl( "country|state|gender|taxonomy|postal" , column_names ) , 'n' , 'c' ) columns_to_import <- c( "entity_type_code" , "provider_gender_code" , "provider_enumeration_date" , "is_sole_proprietor" , "provider_business_practice_location_address_state_name" ) stopifnot( all( columns_to_import %in% column_names ) ) # readr::read_csv() columns must match their order in the csv file columns_to_import <- columns_to_import[ order( match( columns_to_import , column_names ) ) ] nppes_tbl <- readr::read_csv( npi_filepath , col_names = columns_to_import , col_types = paste0( ifelse( column_names %in% columns_to_import , column_types , '_' ) , collapse = "" ) , skip = 1 ) nppes_df <- data.frame( nppes_tbl ) Save locally   Save the object at any point: # nppes_fn <- file.path( path.expand( "~" ) , "NPPES" , "this_file.rds" ) # saveRDS( nppes_df , file = nppes_fn , compress = FALSE ) Load the same object: # nppes_df <- readRDS( nppes_fn ) Variable Recoding Add new columns to the data set: nppes_df <- transform( nppes_df , individual = as.numeric( entity_type_code ) , provider_enumeration_year = as.numeric( substr( provider_enumeration_date , 7 , 10 ) ) , state_name = provider_business_practice_location_address_state_name ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( nppes_df ) table( nppes_df[ , "provider_gender_code" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( nppes_df[ , "provider_enumeration_year" ] , na.rm = TRUE ) tapply( nppes_df[ , "provider_enumeration_year" ] , nppes_df[ , "provider_gender_code" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( nppes_df[ , "is_sole_proprietor" ] ) ) prop.table( table( nppes_df[ , c( "is_sole_proprietor" , "provider_gender_code" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( nppes_df[ , "provider_enumeration_year" ] , na.rm = TRUE ) tapply( nppes_df[ , "provider_enumeration_year" ] , nppes_df[ , "provider_gender_code" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( nppes_df[ , "provider_enumeration_year" ] , 0.5 , na.rm = TRUE ) tapply( nppes_df[ , "provider_enumeration_year" ] , nppes_df[ , "provider_gender_code" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to California: sub_nppes_df <- subset( nppes_df , state_name = 'CA' ) Calculate the mean (average) of this subset: mean( sub_nppes_df[ , "provider_enumeration_year" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( nppes_df[ , "provider_enumeration_year" ] , na.rm = TRUE ) tapply( nppes_df[ , "provider_enumeration_year" ] , nppes_df[ , "provider_gender_code" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( provider_enumeration_year ~ individual , nppes_df ) Perform a chi-squared test of association: this_table <- table( nppes_df[ , c( "individual" , "is_sole_proprietor" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( provider_enumeration_year ~ individual + is_sole_proprietor , data = nppes_df ) summary( glm_result ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for NPPES users, this code replicates previously-presented examples: library(dplyr) nppes_tbl <- as_tibble( nppes_df ) Calculate the mean (average) of a linear variable, overall and by groups: nppes_tbl %>% summarize( mean = mean( provider_enumeration_year , na.rm = TRUE ) ) nppes_tbl %>% group_by( provider_gender_code ) %>% summarize( mean = mean( provider_enumeration_year , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for NPPES users, this code replicates previously-presented examples: library(data.table) nppes_dt <- data.table( nppes_df ) Calculate the mean (average) of a linear variable, overall and by groups: nppes_dt[ , mean( provider_enumeration_year , na.rm = TRUE ) ] nppes_dt[ , mean( provider_enumeration_year , na.rm = TRUE ) , by = provider_gender_code ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for NPPES users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'nppes' , nppes_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( provider_enumeration_year ) FROM nppes' ) dbGetQuery( con , 'SELECT provider_gender_code , AVG( provider_enumeration_year ) FROM nppes GROUP BY provider_gender_code' ) "],["national-survey-of-childrens-health-nsch.html", "National Survey of Children’s Health (NSCH) Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " National Survey of Children’s Health (NSCH) Estimates of children’s health care and family environments to inform reports like Healthy People 2030. One screener table with one row per eligible child (1+ rows per household), one topical table with the sampled child (only one row per household) from three stacked age-specific questionnaires. A complex sample survey designed to generalize to non-institutionalized U.S. children under 18. Released every four or five years since 2003, annually since 2016. Sponsored by the Maternal and Child Health Bureau, Health Resources and Services Administration. Please skim before you begin: 2021 National Survey of Children’s Health Methodology Report 2021 National Survey of Children’s Health Data Users Frequently Asked Questions (FAQs) This human-composed haiku or a bouquet of artificial intelligence-generated limericks # "age but a number" # lied babe from crib. "your nose grows" # cried gramps changing bib Download, Import, Preparation Define a function to download, unzip, and import each comma-separated value file: library(haven) nsch_stata_import <- function( this_url ){ this_tf <- tempfile() download.file( this_url , this_tf , mode = 'wb' ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) this_stata <- grep( '\\\\.dta$' , unzipped_files , value = TRUE ) this_tbl <- read_stata( this_stata ) this_df <- data.frame( this_tbl ) file.remove( c( this_tf , unzipped_files ) ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the sample adult interview and imputed income files: nsch_screener_url <- "https://www2.census.gov/programs-surveys/nsch/datasets/2021/nsch_2021_screener_Stata.zip" nsch_topical_url <- "https://www2.census.gov/programs-surveys/nsch/datasets/2021/nsch_2021_topical_Stata.zip" nsch_screener_df <- nsch_stata_import( nsch_screener_url ) nsch_df <- nsch_stata_import( nsch_topical_url ) Save locally   Save the object at any point: # nsch_fn <- file.path( path.expand( "~" ) , "NSCH" , "this_file.rds" ) # saveRDS( nsch_df , file = nsch_fn , compress = FALSE ) Load the same object: # nsch_df <- readRDS( nsch_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: Remove the fpl columns from the main data.frame: fpl_columns <- grep( '^fpl_i[0-9]' , names( nsch_df ) , value = TRUE ) fpl_wide_df <- nsch_df[ c( 'hhid' , fpl_columns ) ] nsch_df[ fpl_columns ] <- NULL Reshape the fpl columns from wide to long: fpl_long_df <- reshape( fpl_wide_df , varying = list( fpl_columns ) , direction = 'long' , timevar = 'implicate' , idvar = 'hhid' ) names( fpl_long_df )[ ncol( fpl_long_df ) ] <- 'fpl' Merge the fpl table with multiple records per child onto the main table: nsch_long_df <- merge( nsch_df , fpl_long_df ) stopifnot( nrow( nsch_long_df ) == nrow( fpl_long_df ) ) stopifnot( nrow( nsch_long_df ) / length( fpl_columns ) == nrow( nsch_df ) ) Reshape the imputed income data.frame into a list based on the implicate number: nsch_list <- split( nsch_long_df , nsch_long_df[ , 'implicate' ] ) Define the design: library(survey) library(mitools) nsch_design <- svydesign( id = ~ 1 , strata = ~ fipsst + stratum , weights = ~ fwc , data = imputationList( nsch_list ) , nest = TRUE ) Variable Recoding Add new columns to the data set: nsch_design <- update( nsch_design , one = 1 , state_name = factor( fipsst , levels = c(1L, 2L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 12L, 13L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 53L, 54L, 55L, 56L) , labels = c("Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "District of Columbia", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming") ) , overall_health = factor( c( 1 , 1 , 2 , 3 , 3 )[ k2q01 ] , levels = 1:3 , labels = c( 'excellent or very good' , 'good' , 'fair or poor' ) ) , poverty_categories = factor( 1 + findInterval( fpl , c( 100 , 200 , 400 ) ) , labels = c( "below poverty" , "100-199% fpl" , "200-399% fpl" , "400%+ fpl" ) ) , under_six_ever_breastfed = as.numeric( k6q40 == 1 ) , sc_sex = factor( ifelse( sc_sex %in% 1:2 , sc_sex , NA ) , labels = c( "male" , "female" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: MIcombine( with( nsch_design , svyby( ~ one , ~ one , unwtd.count ) ) ) MIcombine( with( nsch_design , svyby( ~ one , ~ state_name , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: MIcombine( with( nsch_design , svytotal( ~ one ) ) ) MIcombine( with( nsch_design , svyby( ~ one , ~ state_name , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: MIcombine( with( nsch_design , svymean( ~ sc_age_years ) ) ) MIcombine( with( nsch_design , svyby( ~ sc_age_years , ~ state_name , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: MIcombine( with( nsch_design , svymean( ~ poverty_categories ) ) ) MIcombine( with( nsch_design , svyby( ~ poverty_categories , ~ state_name , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: MIcombine( with( nsch_design , svytotal( ~ sc_age_years ) ) ) MIcombine( with( nsch_design , svyby( ~ sc_age_years , ~ state_name , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: MIcombine( with( nsch_design , svytotal( ~ poverty_categories ) ) ) MIcombine( with( nsch_design , svyby( ~ poverty_categories , ~ state_name , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: MIcombine( with( nsch_design , svyquantile( ~ sc_age_years , 0.5 , se = TRUE ) ) ) MIcombine( with( nsch_design , svyby( ~ sc_age_years , ~ state_name , svyquantile , 0.5 , se = TRUE , ci = TRUE ) ) ) Estimate a ratio: MIcombine( with( nsch_design , svyratio( numerator = ~ liveusa_yr , denominator = ~ sc_age_years ) ) ) Subsetting Restrict the survey design to only children: sub_nsch_design <- subset( nsch_design , agepos4 == 1 ) Calculate the mean (average) of this subset: MIcombine( with( sub_nsch_design , svymean( ~ sc_age_years ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- MIcombine( with( nsch_design , svymean( ~ sc_age_years ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- MIcombine( with( nsch_design , svyby( ~ sc_age_years , ~ state_name , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nsch_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: MIcombine( with( nsch_design , svyvar( ~ sc_age_years ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement MIcombine( with( nsch_design , svymean( ~ sc_age_years , deff = TRUE ) ) ) # SRS with replacement MIcombine( with( nsch_design , svymean( ~ sc_age_years , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ under_six_ever_breastfed , nsch_design , # method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( sc_age_years ~ under_six_ever_breastfed , nsch_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ under_six_ever_breastfed + poverty_categories , nsch_design ) Perform a survey-weighted generalized linear model: glm_result <- MIcombine( with( nsch_design , svyglm( sc_age_years ~ under_six_ever_breastfed + poverty_categories ) ) ) summary( glm_result ) Replication Example As noted in the bold red footnotes of their published table, this technique is not correct and should not be used. The technical documents recommend a method matching the MIcombine syntax shown above. Nonetheless, this code matches statistics and confidence intervals within 0.5% from the Excellent or very good column of Indicator 1.1: In general, how would you describe this child’s health?: results <- svyby( ~ as.numeric( overall_health == 'excellent or very good' ) , ~ poverty_categories , nsch_design$designs[[1]] , svymean , na.rm = TRUE ) published_proportions <- c( 0.833 , 0.859 , 0.907 , 0.955 ) published_lb <- c( 0.810 , 0.838 , 0.894 , 0.949 ) published_ub <- c( 0.854 , 0.878 , 0.919 , 0.961 ) stopifnot( all( abs( round( coef( results ) , 3 ) - published_proportions ) < 0.005 ) ) ( ci_results <- confint( results ) ) stopifnot( all( abs( ci_results[ , 1 ] - published_lb ) < 0.005 ) ) stopifnot( all( abs( ci_results[ , 2 ] - published_ub ) < 0.005 ) ) "],["national-survey-on-drug-use-and-health-nsduh.html", "National Survey on Drug Use and Health (NSDUH) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Survey on Drug Use and Health (NSDUH) The primary survey to measure of prevalence of substance use and its correlates in the United States. One table with one row per sampled respondent. A complex survey designed to generalize to civilian, non-institutional americans aged 12 and older. Released periodically since 1979 and annually since 1990. Administered by the Substance Abuse and Mental Health Services Administration. Please skim before you begin: 2021 National Survey on Drug Use and Health (NSDUH): Public Use File Codebook 2021 National Survey on Drug Use and Health (NSDUH): Methodological Summary and Definitions This human-composed haiku or a bouquet of artificial intelligence-generated limericks # drinking and thinking # about your first time, were you # smoking and joking? Download, Import, Preparation Download and import the national file: zip_tf <- tempfile() zip_url <- paste0( "https://www.datafiles.samhsa.gov/sites/default/files/field-uploads-protected/" , "studies/NSDUH-2021/NSDUH-2021-datasets/NSDUH-2021-DS0001/" , "NSDUH-2021-DS0001-bundles-with-study-info/NSDUH-2021-DS0001-bndl-data-r_v3.zip" ) download.file( zip_url , zip_tf , mode = 'wb' ) nsduh_rdata <- unzip( zip_tf , exdir = tempdir() ) nsduh_rdata_contents <- load( nsduh_rdata ) nsduh_df_name <- grep( 'PUF' , nsduh_rdata_contents , value = TRUE ) nsduh_df <- get( nsduh_df_name ) names( nsduh_df ) <- tolower( names( nsduh_df ) ) nsduh_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # nsduh_fn <- file.path( path.expand( "~" ) , "NSDUH" , "this_file.rds" ) # saveRDS( nsduh_df , file = nsduh_fn , compress = FALSE ) Load the same object: # nsduh_df <- readRDS( nsduh_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) nsduh_design <- svydesign( id = ~ verep , strata = ~ vestr_c , data = nsduh_df , weights = ~ analwt_c , nest = TRUE ) Variable Recoding Add new columns to the data set: nsduh_design <- update( nsduh_design , one = 1 , health = factor( health , levels = 1:5 , labels = c( "excellent" , "very good" , "good" , "fair" , "poor" ) ) , age_first_cigarette = ifelse( cigtry > 99 , NA , cigtry ) , age_tried_cocaine = ifelse( cocage > 99 , NA , cocage ) , ever_used_marijuana = as.numeric( ifelse( mjever < 4 , mjever == 1 , NA ) ) , county_type = factor( coutyp4 , levels = 1:3 , labels = c( "large metro" , "small metro" , "nonmetro" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nsduh_design , "sampling" ) != 0 ) svyby( ~ one , ~ county_type , nsduh_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nsduh_design ) svyby( ~ one , ~ county_type , nsduh_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ age_first_cigarette , nsduh_design , na.rm = TRUE ) svyby( ~ age_first_cigarette , ~ county_type , nsduh_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ health , nsduh_design , na.rm = TRUE ) svyby( ~ health , ~ county_type , nsduh_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ age_first_cigarette , nsduh_design , na.rm = TRUE ) svyby( ~ age_first_cigarette , ~ county_type , nsduh_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ health , nsduh_design , na.rm = TRUE ) svyby( ~ health , ~ county_type , nsduh_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ age_first_cigarette , nsduh_design , 0.5 , na.rm = TRUE ) svyby( ~ age_first_cigarette , ~ county_type , nsduh_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ age_first_cigarette , denominator = ~ age_tried_cocaine , nsduh_design , na.rm = TRUE ) Subsetting Restrict the survey design to individuals who are pregnant: sub_nsduh_design <- subset( nsduh_design , preg == 1 ) Calculate the mean (average) of this subset: svymean( ~ age_first_cigarette , sub_nsduh_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ age_first_cigarette , nsduh_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ age_first_cigarette , ~ county_type , nsduh_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nsduh_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ age_first_cigarette , nsduh_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ age_first_cigarette , nsduh_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ age_first_cigarette , nsduh_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ ever_used_marijuana , nsduh_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( age_first_cigarette ~ ever_used_marijuana , nsduh_design ) Perform a chi-squared test of association for survey data: svychisq( ~ ever_used_marijuana + health , nsduh_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( age_first_cigarette ~ ever_used_marijuana + health , nsduh_design ) summary( glm_result ) Replication Example This matches the prevalence and SE of alcohol use in the past month from Codebook Table G.2: result <- svymean( ~ alcmon , nsduh_design ) stopifnot( round( coef( result ) , 3 ) == 0.474 ) stopifnot( round( SE( result ) , 4 ) == 0.0043 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NSDUH users, this code replicates previously-presented examples: library(srvyr) nsduh_srvyr_design <- as_survey( nsduh_design ) Calculate the mean (average) of a linear variable, overall and by groups: nsduh_srvyr_design %>% summarize( mean = survey_mean( age_first_cigarette , na.rm = TRUE ) ) nsduh_srvyr_design %>% group_by( county_type ) %>% summarize( mean = survey_mean( age_first_cigarette , na.rm = TRUE ) ) "],["national-survey-of-family-growth-nsfg.html", "National Survey of Family Growth (NSFG) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Survey of Family Growth (NSFG) The principal survey to measure reproductive behavior in the United States population. Multiple tables with one row per respondent for the female and male tables, then a separate table with one row per pregnancy. A complex sample survey designed to generalize to the 15-49 year old population of the United States, by gender. Released every couple of years since 1973. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: Sample Design Documentation Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # family structure # questions cuz radar fails at # storks with bassinets Download, Import, Preparation library(SAScii) library(readr) dat_url <- "https://ftp.cdc.gov/pub/Health_Statistics/NCHS/Datasets/NSFG/2017_2019_FemRespData.dat" sas_url <- file.path( dirname( dat_url ) , "sas/2017_2019_FemRespSetup.sas" ) sas_positions <- parse.SAScii( sas_url ) sas_positions[ , 'varname' ] <- tolower( sas_positions[ , 'varname' ] ) sas_positions[ , 'column_types' ] <- ifelse( sas_positions[ , 'char' ] , "c" , "d" ) nsfg_tbl <- read_fwf( dat_url , fwf_widths( abs( sas_positions[ , 'width' ] ) , col_names = sas_positions[ , 'varname' ] ) , col_types = paste0( sas_positions[ , 'column_types' ] , collapse = "" ) , na = c( "" , "." ) ) nsfg_df <- data.frame( nsfg_tbl ) Save locally   Save the object at any point: # nsfg_fn <- file.path( path.expand( "~" ) , "NSFG" , "this_file.rds" ) # saveRDS( nsfg_df , file = nsfg_fn , compress = FALSE ) Load the same object: # nsfg_df <- readRDS( nsfg_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) nsfg_design <- svydesign( id = ~ secu , strata = ~ sest , data = nsfg_df , weights = ~ wgt2017_2019 , nest = TRUE ) Variable Recoding Add new columns to the data set: nsfg_design <- update( nsfg_design , one = 1 , birth_control_pill = as.numeric( constat1 == 6 ) , age_categories = factor( findInterval( ager , c( 15 , 20 , 25 , 30 , 35 , 40 ) ) , labels = c( '15-19' , '20-24' , '25-29' , '30-34' , '35-39' , '40-49' ) ) , marstat = factor( marstat , levels = c( 1:6 , 8:9 ) , labels = c( "Married to a person of the opposite sex" , "Not married but living together with a partner of the opposite sex" , "Widowed" , "Divorced or annulled" , "Separated, because you and your spouse are not getting along" , "Never been married" , "Refused" , "Don't know" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nsfg_design , "sampling" ) != 0 ) svyby( ~ one , ~ age_categories , nsfg_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nsfg_design ) svyby( ~ one , ~ age_categories , nsfg_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ pregnum , nsfg_design , na.rm = TRUE ) svyby( ~ pregnum , ~ age_categories , nsfg_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ marstat , nsfg_design ) svyby( ~ marstat , ~ age_categories , nsfg_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ pregnum , nsfg_design , na.rm = TRUE ) svyby( ~ pregnum , ~ age_categories , nsfg_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ marstat , nsfg_design ) svyby( ~ marstat , ~ age_categories , nsfg_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ pregnum , nsfg_design , 0.5 , na.rm = TRUE ) svyby( ~ pregnum , ~ age_categories , nsfg_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ pregnum , denominator = ~ lbpregs , nsfg_design , na.rm = TRUE ) Subsetting Restrict the survey design to ever cohabited: sub_nsfg_design <- subset( nsfg_design , timescoh > 0 ) Calculate the mean (average) of this subset: svymean( ~ pregnum , sub_nsfg_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ pregnum , nsfg_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ pregnum , ~ age_categories , nsfg_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nsfg_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ pregnum , nsfg_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ pregnum , nsfg_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ pregnum , nsfg_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ birth_control_pill , nsfg_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( pregnum ~ birth_control_pill , nsfg_design ) Perform a chi-squared test of association for survey data: svychisq( ~ birth_control_pill + marstat , nsfg_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( pregnum ~ birth_control_pill + marstat , nsfg_design ) summary( glm_result ) Replication Example This example matches the Variance Estimates for Percentages using SAS (9.4) and STATA (14): Match the sum of the weights: result <- svytotal( ~ one , nsfg_design ) stopifnot( round( coef( result ) , 0 ) == 72671926 ) stopifnot( round( SE( result ) , 0 ) == 3521465 ) Match row percentages of women currently using the pill by age: row_percents <- c( 19.5112 , 23.7833 , 19.6916 , 15.2800 , 6.4965 , 6.5215 ) std_err_row_percents <- c( 1.8670 , 2.1713 , 2.2773 , 1.7551 , 0.9895 , 1.0029 ) results <- svyby( ~ birth_control_pill , ~ age_categories , nsfg_design , svymean ) stopifnot( all( round( coef( results ) * 100 , 4 ) == row_percents ) ) stopifnot( all( round( SE( results ) * 100 , 4 ) == std_err_row_percents ) ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NSFG users, this code replicates previously-presented examples: library(srvyr) nsfg_srvyr_design <- as_survey( nsfg_design ) Calculate the mean (average) of a linear variable, overall and by groups: nsfg_srvyr_design %>% summarize( mean = survey_mean( pregnum , na.rm = TRUE ) ) nsfg_srvyr_design %>% group_by( age_categories ) %>% summarize( mean = survey_mean( pregnum , na.rm = TRUE ) ) "],["new-york-city-housing-and-vacancy-survey-nychvs.html", "New York City Housing and Vacancy Survey (NYCHVS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " New York City Housing and Vacancy Survey (NYCHVS) A city-wide assessment of the rental vacancy rate and other characteristics related to housing stock. One table with one record per occupied housing unit, a second table with one record per person inside each occupied housing unit, and a third table with one record per unoccupied housing unit. A complex sample designed to generalize to occupied & unoccupied housing in the five boroughs. Released more or less triennially since 1991. Funded by the NYC Dept. of Housing Preservation & Development, run by the Census Bureau. Please skim before you begin: Public Use File User Guide and Codebook Sample Design, Weighting, and Error Estimation This human-composed haiku or a bouquet of artificial intelligence-generated limericks # all i want is a # room somewhere / with clawfoot tub # and a frigidaire Download, Import, Preparation Define a function to download and import each comma-separated value file: nychvs_csv_import <- function( this_url ){ tf <- tempfile() download.file( this_url , tf , mode = 'wb' ) this_df <- read.csv( tf ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the all units, occupied units, person, and vacant units tables: datasets_url <- "https://www2.census.gov/programs-surveys/nychvs/datasets/2021/microdata/" all_units_df <- nychvs_csv_import( paste0( datasets_url , "allunits_puf_21.csv" ) ) occupied_units_df <- nychvs_csv_import( paste0( datasets_url , "occupied_puf_21.csv" ) ) person_df <- nychvs_csv_import( paste0( datasets_url , "person_puf_21.csv" ) ) vacant_units_df <- nychvs_csv_import( paste0( datasets_url , "vacant_puf_21.csv" ) ) stopifnot( nrow( all_units_df ) == nrow( occupied_units_df ) + nrow( vacant_units_df ) ) Merge the information stored in the all units table onto both the occupied and vacant unit tables, then merge the information (not related to weighting) from the occupied unit table onto the person table: before_nrow <- nrow( occupied_units_df ) occupied_units_df <- merge( all_units_df , occupied_units_df ) stopifnot( nrow( occupied_units_df ) == before_nrow ) before_nrow <- nrow( vacant_units_df ) vacant_units_df <- merge( all_units_df , vacant_units_df ) stopifnot( nrow( vacant_units_df ) == before_nrow ) before_nrow <- nrow( person_df ) weighting_variables <- grep( "^fw([0-9]+)?$" , names( occupied_units_df ) , value = TRUE ) person_df <- merge( occupied_units_df[ setdiff( names( occupied_units_df ) , weighting_variables ) ] , person_df ) stopifnot( nrow( person_df ) == before_nrow ) all_units_df[ , 'one' ] <- occupied_units_df[ , 'one' ] <- vacant_units_df[ , 'one' ] <- person_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # nychvs_fn <- file.path( path.expand( "~" ) , "NYCHVS" , "this_file.rds" ) # saveRDS( nychvs_df , file = nychvs_fn , compress = FALSE ) Load the same object: # nychvs_df <- readRDS( nychvs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) all_units_design <- svrepdesign( weight = ~fw , repweights = 'fw[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = all_units_df ) occupied_units_design <- svrepdesign( weight = ~fw , repweights = 'fw[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = occupied_units_df ) vacant_units_design <- svrepdesign( weight = ~fw , repweights = 'fw[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = vacant_units_df ) person_design <- svrepdesign( weight = ~pw , repweights = 'pw[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = person_df ) nychvs_design <- occupied_units_design Variable Recoding Add new columns to the data set: nychvs_design <- update( nychvs_design , one = 1 , home_owners = as.numeric( tenure == 2 ) , yearly_household_income = hhinc_rec1 , rent_amount = ifelse( rent_amount == -2 , NA , rent_amount ) , borough = factor( boro , levels = 1:5 , labels = c( 'Bronx' , 'Brooklyn' , 'Manhattan' , 'Queens' , 'Staten Island' ) ) , food_insecurity = factor( foodinsecure , levels = 1:3 , labels = c( 'not insecure' , 'insecure' , 'very insecure' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nychvs_design , "sampling" ) != 0 ) svyby( ~ one , ~ borough , nychvs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nychvs_design ) svyby( ~ one , ~ borough , nychvs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) svyby( ~ hhinc_rec1 , ~ borough , nychvs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ food_insecurity , nychvs_design , na.rm = TRUE ) svyby( ~ food_insecurity , ~ borough , nychvs_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) svyby( ~ hhinc_rec1 , ~ borough , nychvs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ food_insecurity , nychvs_design , na.rm = TRUE ) svyby( ~ food_insecurity , ~ borough , nychvs_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ hhinc_rec1 , nychvs_design , 0.5 , na.rm = TRUE ) svyby( ~ hhinc_rec1 , ~ borough , nychvs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ rent_amount , denominator = ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) Subsetting Restrict the survey design to rent burdened units (more than 30% of income paid toward rent alone): sub_nychvs_design <- subset( nychvs_design , rentburden_cat %in% 1:2 ) Calculate the mean (average) of this subset: svymean( ~ hhinc_rec1 , sub_nychvs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ hhinc_rec1 , ~ borough , nychvs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nychvs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ home_owners , nychvs_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( hhinc_rec1 ~ home_owners , nychvs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ home_owners + food_insecurity , nychvs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( hhinc_rec1 ~ home_owners + food_insecurity , nychvs_design ) summary( glm_result ) Replication Example This example matches the estimate and standard error of the number of occupied housing units across the five boroughs shown at minute 6:05: result <- svytotal( ~ one , nychvs_design ) stopifnot( round( coef( result ) , 0 ) == 3157105 ) stopifnot( round( SE( result ) , 0 ) == 13439 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NYCHVS users, this code replicates previously-presented examples: library(srvyr) nychvs_srvyr_design <- as_survey( nychvs_design ) Calculate the mean (average) of a linear variable, overall and by groups: nychvs_srvyr_design %>% summarize( mean = survey_mean( hhinc_rec1 , na.rm = TRUE ) ) nychvs_srvyr_design %>% group_by( borough ) %>% summarize( mean = survey_mean( hhinc_rec1 , na.rm = TRUE ) ) "],["programme-for-the-international-assessment-of-adult-competencies-piaac.html", "Programme for the International Assessment of Adult Competencies (PIAAC) Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Programme for the International Assessment of Adult Competencies (PIAAC) A cross-national study designed to understand the skills of workers in advanced-nation labor markets. One row per sampled adult. A multiply-imputed, complex sample survey designed to generalize to the population aged 16 to 65 across thirty three OECD nations. No expected release timeline. Administered by the Organisation for Economic Co-operation and Development. Please skim before you begin: Technical Report of the Survey of Adult Skills Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # what color collar # workforce poets, potters, or # pythagoreans Download, Import, Preparation library(haven) library(httr) tf <- tempfile() this_url <- "https://webfs.oecd.org/piaac/puf-data/SAS/SAS7BDAT/prgusap1_2012.sas7bdat" GET( this_url , write_disk( tf ) , progress() ) piaac_tbl <- read_sas( tf ) piaac_df <- data.frame( piaac_tbl ) names( piaac_df ) <- tolower( names( piaac_df ) ) Save locally   Save the object at any point: # piaac_fn <- file.path( path.expand( "~" ) , "PIAAC" , "this_file.rds" ) # saveRDS( piaac_df , file = piaac_fn , compress = FALSE ) Load the same object: # piaac_df <- readRDS( piaac_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: library(survey) library(mitools) pvals <- c( "pvlit" , "pvnum" , "pvpsl" ) pvars <- outer( pvals , 1:10 , paste0 ) non.pvals <- names(piaac_df)[ !( names(piaac_df) %in% pvars ) ] for(k in 1:10){ piaac_imp <- piaac_df[ , c( non.pvals , paste0( pvals , k ) ) ] for( j in pvals ){ piaac_imp[ , j ] <- piaac_imp[ , paste0( j , k ) ] piaac_imp[ , paste0( j , k ) ] <- NULL } if( k == 1 ){ piaac_mi <- list( piaac_imp ) } else { piaac_mi <- c( piaac_mi , list( piaac_imp ) ) } } jk.method <- unique( piaac_df[ , 'vemethod' ] ) stopifnot(length(jk.method) == 1) stopifnot(jk.method %in% c("JK1", "JK2")) if (jk.method == "JK2") jk.method <- "JKn" piaac_design <- svrepdesign( weights = ~spfwt0 , repweights = "spfwt[1-9]" , rscales = rep( 1 , 80 ) , scale = ifelse( jk.method == "JKn" , 1 , 79/80 ) , type = jk.method , data = imputationList( piaac_mi ) , mse = TRUE ) Variable Recoding Add new columns to the data set: piaac_design <- update( piaac_design , one = 1 , sex = factor( gender_r , labels = c( "male" , "female" ) ) , age_categories = factor( ageg10lfs , levels = 1:5 , labels = c( "24 or less" , "25-34" , "35-44" , "45-54" , "55 plus" ) ) , working_at_paid_job_last_week = as.numeric( c_q01a == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: MIcombine( with( piaac_design , svyby( ~ one , ~ one , unwtd.count ) ) ) MIcombine( with( piaac_design , svyby( ~ one , ~ age_categories , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: MIcombine( with( piaac_design , svytotal( ~ one ) ) ) MIcombine( with( piaac_design , svyby( ~ one , ~ age_categories , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE ) ) ) MIcombine( with( piaac_design , svyby( ~ pvnum , ~ age_categories , svymean , na.rm = TRUE ) ) ) Calculate the distribution of a categorical variable, overall and by groups: MIcombine( with( piaac_design , svymean( ~ sex ) ) ) MIcombine( with( piaac_design , svyby( ~ sex , ~ age_categories , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: MIcombine( with( piaac_design , svytotal( ~ pvnum , na.rm = TRUE ) ) ) MIcombine( with( piaac_design , svyby( ~ pvnum , ~ age_categories , svytotal , na.rm = TRUE ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: MIcombine( with( piaac_design , svytotal( ~ sex ) ) ) MIcombine( with( piaac_design , svyby( ~ sex , ~ age_categories , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: MIcombine( with( piaac_design , svyquantile( ~ pvnum , 0.5 , se = TRUE , na.rm = TRUE ) ) ) MIcombine( with( piaac_design , svyby( ~ pvnum , ~ age_categories , svyquantile , 0.5 , se = TRUE , ci = TRUE , na.rm = TRUE ) ) ) Estimate a ratio: MIcombine( with( piaac_design , svyratio( numerator = ~ pvnum , denominator = ~ pvlit , na.rm = TRUE ) ) ) Subsetting Restrict the survey design to self-reported fair or poor health: sub_piaac_design <- subset( piaac_design , i_q08 %in% 4:5 ) Calculate the mean (average) of this subset: MIcombine( with( sub_piaac_design , svymean( ~ pvnum , na.rm = TRUE ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- MIcombine( with( piaac_design , svyby( ~ pvnum , ~ age_categories , svymean , na.rm = TRUE ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( piaac_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: MIcombine( with( piaac_design , svyvar( ~ pvnum , na.rm = TRUE ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE , deff = TRUE ) ) ) # SRS with replacement MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ working_at_paid_job_last_week , piaac_design , # method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( pvnum ~ working_at_paid_job_last_week , piaac_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ working_at_paid_job_last_week + sex , piaac_design ) Perform a survey-weighted generalized linear model: glm_result <- MIcombine( with( piaac_design , svyglm( pvnum ~ working_at_paid_job_last_week + sex ) ) ) summary( glm_result ) Replication Example This example matches the statistics and standard errors from OECD’s Technical Report Table 18.9: usa_pvlit <- MIcombine( with( piaac_design , svymean( ~ pvlit , na.rm = TRUE ) ) ) usa_pvnum <- MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE ) ) ) usa_pvpsl <- MIcombine( with( piaac_design , svymean( ~ pvpsl , na.rm = TRUE ) ) ) stopifnot( round( coef( usa_pvlit ) ) == 270 ) stopifnot( round( SE( usa_pvlit ) , 1 ) == 1.0 ) stopifnot( round( coef( usa_pvnum ) ) == 253 ) stopifnot( round( SE( usa_pvnum ) , 1 ) == 1.2 ) stopifnot( round( coef( usa_pvpsl ) ) == 277 ) stopifnot( round( SE( usa_pvpsl ) , 1 ) == 1.1 ) "],["progress-in-international-reading-literacy-study-pirls.html", "Progress in International Reading Literacy Study (PIRLS) Function Definitions Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Progress in International Reading Literacy Study (PIRLS) A comparative study of student achievement in reading and literacy across more than 50 nations. Grade-specific tables with one record per school, student, teacher, plus files containing student achievement, home background, student-teacher linkage, and within-country scoring reliability. A complex survey generalizing to fourth-grade populations of participating countries. Released quinquennially since 2001. Funded by the International Association for the Evaluation of Educational Achievement, run at BC. Please skim before you begin: PIRLS 2021 User Guide for the International Database Methods and Procedures: PIRLS 2021 Technical Report This human-composed haiku or a bouquet of artificial intelligence-generated limericks # lascaux canary # glyph jump reveal caged bard notes # cryogenesis Function Definitions This survey uses a multiply-imputed variance estimation technique described in Methods Chapter 13. Most users do not need to study this function carefully. Define a function specific to only this dataset: pirls_MIcombine <- function (results, variances, call = sys.call(), df.complete = Inf, ...) { m <- length(results) oldcall <- attr(results, "call") if (missing(variances)) { variances <- suppressWarnings(lapply(results, vcov)) results <- lapply(results, coef) } vbar <- variances[[1]] cbar <- results[[1]] for (i in 2:m) { cbar <- cbar + results[[i]] vbar <- vbar + variances[[i]] } cbar <- cbar/m vbar <- vbar/m # MODIFICATION # evar <- var(do.call("rbind", results)) evar <- sum( ( unlist( results ) - cbar )^2 / 4 ) r <- (1 + 1/m) * evar/vbar df <- (m - 1) * (1 + 1/r)^2 if (is.matrix(df)) df <- diag(df) if (is.finite(df.complete)) { dfobs <- ((df.complete + 1)/(df.complete + 3)) * df.complete * vbar/(vbar + evar) if (is.matrix(dfobs)) dfobs <- diag(dfobs) df <- 1/(1/dfobs + 1/df) } if (is.matrix(r)) r <- diag(r) rval <- list(coefficients = cbar, variance = vbar + evar * (m + 1)/m, call = c(oldcall, call), nimp = m, df = df, missinfo = (r + 2/(df + 3))/(r + 1)) class(rval) <- "MIresult" rval } Download, Import, Preparation Download and unzip the 2021 fourth grade international database: library(httr) tf <- tempfile() this_url <- "https://pirls2021.org/data/downloads/P21_Data_R.zip" GET( this_url , write_disk( tf ) , progress() ) unzipped_files <- unzip( tf , exdir = tempdir() ) Import and stack each of the student context data files for Abu Dhabi through Bulgaria: library(haven) # limit unzipped files to those starting with `asg` followed by three letters followed by `r5` asg_fns <- unzipped_files[ grepl( '^asg[a-z][a-z][a-z]r5' , basename( unzipped_files ) , ignore.case = TRUE ) ] # further limit asg files to the first ten countries countries_thru_bulgaria <- c("aad", "adu", "alb", "are", "aus", "aut", "aze", "bfl", "bfr", "bgr") fns_thru_bulgaria <- paste0( paste0( '^asg' , countries_thru_bulgaria , 'r5' ) , collapse = "|" ) asg_aad_bgr_fns <- asg_fns[ grepl( fns_thru_bulgaria , basename( asg_fns ) , ignore.case = TRUE ) ] pirls_df <- NULL for( rdata_fn in asg_aad_bgr_fns ){ this_tbl_name <- load( rdata_fn ) this_tbl <- get( this_tbl_name ) ; rm( this_tbl_name ) this_tbl <- zap_labels( this_tbl ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) pirls_df <- rbind( pirls_df , this_df ) } # order the data.frame by unique student id pirls_df <- pirls_df[ with( pirls_df , order( idcntry , idstud ) ) , ] Save locally   Save the object at any point: # pirls_fn <- file.path( path.expand( "~" ) , "PIRLS" , "this_file.rds" ) # saveRDS( pirls_df , file = pirls_fn , compress = FALSE ) Load the same object: # pirls_df <- readRDS( pirls_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: From among possibly plausible values, determine all columns that are multiply-imputed plausible values: # identify all columns ending with `01` thru `05` ppv <- grep( "(.*)0[1-5]$" , names( pirls_df ) , value = TRUE ) # remove those ending digits ppv_prefix <- gsub( "0[1-5]$" , "" , ppv ) # identify each of the possibilities with exactly five matches (five implicates) pv <- names( table( ppv_prefix )[ table( ppv_prefix ) == 5 ] ) # identify each of the `01` thru `05` plausible value columns pv_columns <- grep( paste0( "^" , pv , "0[1-5]$" , collapse = "|" ) , names( pirls_df ) , value = TRUE ) Extract those multiply-imputed columns into a separate data.frame, then remove them from the source: pv_wide_df <- pirls_df[ c( 'idcntry' , 'idstud' , pv_columns ) ] pirls_df[ pv_columns ] <- NULL Reshape these columns from one record per student to one record per student per implicate: pv_long_df <- reshape( pv_wide_df , varying = lapply( paste0( pv , '0' ) , paste0 , 1:5 ) , direction = 'long' , timevar = 'implicate' , idvar = c( 'idcntry' , 'idstud' ) ) names( pv_long_df ) <- gsub( "01$" , "" , names( pv_long_df ) ) Merge the columns from the source data.frame onto the one record per student per implicate data.frame: pirls_long_df <- merge( pirls_df , pv_long_df ) pirls_long_df <- pirls_long_df[ with( pirls_long_df , order( idcntry , idstud ) ) , ] stopifnot( nrow( pirls_long_df ) == nrow( pv_long_df ) ) stopifnot( nrow( pirls_long_df ) / 5 == nrow( pirls_df ) ) Divide the five plausible value implicates into a list with five data.frames based on the implicate number: pirls_list <- split( pirls_long_df , pirls_long_df[ , 'implicate' ] ) Construct a replicate weights table following the estimation technique described in Methods Chapter 13: weights_df <- pirls_df[ c( 'jkrep' , 'jkzone' ) ] for( j in 1:75 ){ for( i in 0:1 ){ weights_df[ weights_df[ , 'jkzone' ] != j , paste0( 'rw' , i , j ) ] <- 1 weights_df[ weights_df[ , 'jkzone' ] == j , paste0( 'rw' , i , j ) ] <- 2 * ( weights_df[ weights_df[ , 'jkzone' ] == j , 'jkrep' ] == i ) } } weights_df[ c( 'jkrep' , 'jkzone' ) ] <- NULL Define the design: library(survey) library(mitools) pirls_design <- svrepdesign( weights = ~totwgt , repweights = weights_df , data = imputationList( pirls_list ) , type = "other" , scale = 0.5 , rscales = rep( 1 , 150 ) , combined.weights = FALSE , mse = TRUE ) Variable Recoding Add new columns to the data set: pirls_design <- update( pirls_design , one = 1 , countries_thru_bulgaria = factor( as.numeric( idcntry ) , levels = c(7842L, 7841L, 8L, 784L, 36L, 40L, 31L, 956L, 957L, 100L) , labels = c("Abu Dhabi, UAE", "Dubai, UAE", "Albania", "UAE", "Australia", "Austria", "Azerbaijan", "Belgium (Flemish)", "Belgium (French)","Bulgaria") ) , sex = factor( itsex , levels = 1:2 , labels = c( "female" , "male" ) ) , always_speak_language_of_test_at_home = ifelse( asbg03 %in% 1:4 , as.numeric( asbg03 == 1 ) , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: pirls_MIcombine( with( pirls_design , svyby( ~ one , ~ one , unwtd.count ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ one , ~ sex , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: pirls_MIcombine( with( pirls_design , svytotal( ~ one ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ one , ~ sex , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: pirls_MIcombine( with( pirls_design , svymean( ~ asrrea , na.rm = TRUE ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ asrrea , ~ sex , svymean , na.rm = TRUE ) ) ) Calculate the distribution of a categorical variable, overall and by groups: pirls_MIcombine( with( pirls_design , svymean( ~ countries_thru_bulgaria ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ countries_thru_bulgaria , ~ sex , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: pirls_MIcombine( with( pirls_design , svytotal( ~ asrrea , na.rm = TRUE ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ asrrea , ~ sex , svytotal , na.rm = TRUE ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: pirls_MIcombine( with( pirls_design , svytotal( ~ countries_thru_bulgaria ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ countries_thru_bulgaria , ~ sex , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: pirls_MIcombine( with( pirls_design , svyquantile( ~ asrrea , 0.5 , se = TRUE , na.rm = TRUE ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ asrrea , ~ sex , svyquantile , 0.5 , se = TRUE , ci = TRUE , na.rm = TRUE ) ) ) Estimate a ratio: pirls_MIcombine( with( pirls_design , svyratio( numerator = ~ asrlit , denominator = ~ asrrea ) ) ) Subsetting Restrict the survey design to Australia, Austria, Azerbaijan, Belgium (French): sub_pirls_design <- subset( pirls_design , idcntry %in% c( 36 , 40 , 31 , 956 ) ) Calculate the mean (average) of this subset: pirls_MIcombine( with( sub_pirls_design , svymean( ~ asrrea , na.rm = TRUE ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- pirls_MIcombine( with( pirls_design , svymean( ~ asrrea , na.rm = TRUE ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- pirls_MIcombine( with( pirls_design , svyby( ~ asrrea , ~ sex , svymean , na.rm = TRUE ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( pirls_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: pirls_MIcombine( with( pirls_design , svyvar( ~ asrrea , na.rm = TRUE ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement pirls_MIcombine( with( pirls_design , svymean( ~ asrrea , na.rm = TRUE , deff = TRUE ) ) ) # SRS with replacement pirls_MIcombine( with( pirls_design , svymean( ~ asrrea , na.rm = TRUE , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ always_speak_language_of_test_at_home , pirls_design , # method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( asrrea ~ always_speak_language_of_test_at_home , pirls_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ always_speak_language_of_test_at_home + countries_thru_bulgaria , pirls_design ) Perform a survey-weighted generalized linear model: glm_result <- pirls_MIcombine( with( pirls_design , svyglm( asrrea ~ always_speak_language_of_test_at_home + countries_thru_bulgaria ) ) ) summary( glm_result ) Replication Example This example matches the mean proficiency and standard error of the Australia row of the Summary Statistics and Standard Errors for Proficiency in Overall Reading table from the Appendix 13A: Summary Statistics and Standard Errors for Proficiency in Reading: australia_design <- subset( pirls_design , countries_thru_bulgaria %in% "Australia" ) stopifnot( nrow( australia_design ) == 5487 ) result <- pirls_MIcombine( with( australia_design , svymean( ~ asrrea ) ) ) stopifnot( round( coef( result ) , 3 ) == 540.134 ) stopifnot( round( SE( result ) , 3 ) == 1.728 ) This example matches the jackknife sampling, imputation, and total variances of the same row: australia_fn <- unzipped_files[ grepl( 'ASGAUS' , basename( unzipped_files ) ) ] australia_tbl_name <- load( australia_fn ) australia_tbl <- get( australia_tbl_name ) ; rm( australia_tbl_name ) australia_tbl <- zap_labels( australia_tbl ) australia_df <- data.frame( australia_tbl ) names( australia_df ) <- tolower( names( australia_df ) ) estimate <- mean( c( with( australia_df , weighted.mean( asrrea01 , totwgt ) ) , with( australia_df , weighted.mean( asrrea02 , totwgt ) ) , with( australia_df , weighted.mean( asrrea03 , totwgt ) ) , with( australia_df , weighted.mean( asrrea04 , totwgt ) ) , with( australia_df , weighted.mean( asrrea05 , totwgt ) ) ) ) stopifnot( round( estimate , 3 ) == 540.134 ) for( k in 1:5 ){ this_variance <- 0 for( j in 1:75 ){ for( i in 0:1 ){ this_variance <- this_variance + ( weighted.mean( australia_df[ , paste0( 'asrrea0' , k ) ] , ifelse( j == australia_df[ , 'jkzone' ] , australia_df[ , 'totwgt' ] * 2 * ( australia_df[ , 'jkrep' ] == i ) , australia_df[ , 'totwgt' ] ) ) - weighted.mean( australia_df[ , paste0( 'asrrea0' , k ) ] , australia_df[ , 'totwgt' ] ) )^2 } } assign( paste0( 'v' , k ) , this_variance * 0.5 ) } sampling_variance <- mean( c( v1 , v2 , v3 , v4 , v5 ) ) stopifnot( round( sampling_variance , 3 ) == 2.653 ) imputation_variance <- ( 6 / 5 ) * ( ( ( with( australia_df , weighted.mean( asrrea01 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asrrea02 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asrrea03 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asrrea04 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asrrea05 , totwgt ) ) - estimate )^2 / 4 ) ) stopifnot( round( imputation_variance , 3 ) == 0.333 ) stopifnot( round( sampling_variance + imputation_variance , 3 ) == 2.987 ) "],["public-libraries-survey-pls.html", "Public Libraries Survey (PLS) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Public Libraries Survey (PLS) A comprehensive compilation of administrative information on all public libraries in the United States. Two tables, with one record per library system and one record per library building or bookmobile. Released annually since 1992. Conducted by the Institute of Museum and Library Services (IMLS), collected by the Census Bureau. Please skim before you begin: Data File Documentation and User’s Guide README FY #### PLS PUD.txt included in each zipped file This human-composed haiku or a bouquet of artificial intelligence-generated limericks # census, not survey. # dewey decimal index # finger to lips shush Download, Import, Preparation Download and import the most recent administrative entity csv file: this_tf <- tempfile() csv_url <- "https://www.imls.gov/sites/default/files/2023-06/pls_fy2021_csv.zip" download.file( csv_url , this_tf, mode = 'wb' ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) administrative_entity_csv_fn <- unzipped_files[ grepl( 'AE(.*)csv$' , basename( unzipped_files ) ) ] pls_df <- read.csv( administrative_entity_csv_fn ) names( pls_df ) <- tolower( names( pls_df ) ) pls_df[ , 'one' ] <- 1 Recode missing values as described in the readme included with each zipped file: for( this_col in names( pls_df ) ){ if( class( pls_df[ , this_col ] ) == 'character' ){ pls_df[ pls_df[ , this_col ] %in% 'M' , this_col ] <- NA } if( ( class( pls_df[ , this_col ] ) == 'numeric' ) | ( this_col %in% c( 'phone' , 'startdat' , 'enddate' ) ) ){ pls_df[ pls_df[ , this_col ] %in% c( -1 , -3 , -4 , -9 ) , this_col ] <- NA } } Save locally   Save the object at any point: # pls_fn <- file.path( path.expand( "~" ) , "PLS" , "this_file.rds" ) # saveRDS( pls_df , file = pls_fn , compress = FALSE ) Load the same object: # pls_df <- readRDS( pls_fn ) Variable Recoding Add new columns to the data set: pls_df <- transform( pls_df , c_relatn = factor( c_relatn , levels = c( "HQ" , "ME" , "NO" ) , c( "HQ-Headquarters of a federation or cooperative" , "ME-Member of a federation or cooperative" , "NO-Not a member of a federation or cooperative" ) ) , more_than_one_librarian = as.numeric( libraria > 1 ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( pls_df ) table( pls_df[ , "stabr" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( pls_df[ , "popu_lsa" ] , na.rm = TRUE ) tapply( pls_df[ , "popu_lsa" ] , pls_df[ , "stabr" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( pls_df[ , "c_relatn" ] ) ) prop.table( table( pls_df[ , c( "c_relatn" , "stabr" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( pls_df[ , "popu_lsa" ] , na.rm = TRUE ) tapply( pls_df[ , "popu_lsa" ] , pls_df[ , "stabr" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( pls_df[ , "popu_lsa" ] , 0.5 , na.rm = TRUE ) tapply( pls_df[ , "popu_lsa" ] , pls_df[ , "stabr" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to more than one million annual visits: sub_pls_df <- subset( pls_df , visits > 1000000 ) Calculate the mean (average) of this subset: mean( sub_pls_df[ , "popu_lsa" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( pls_df[ , "popu_lsa" ] , na.rm = TRUE ) tapply( pls_df[ , "popu_lsa" ] , pls_df[ , "stabr" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( popu_lsa ~ more_than_one_librarian , pls_df ) Perform a chi-squared test of association: this_table <- table( pls_df[ , c( "more_than_one_librarian" , "c_relatn" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( popu_lsa ~ more_than_one_librarian + c_relatn , data = pls_df ) summary( glm_result ) Replication Example This example matches Interlibrary Relationship Frequencies on PDF page 169 of the User’s Guide: # remove closed and temporarily closed libraries results <- table( pls_df[ !( pls_df[ , 'statstru' ] %in% c( 3 , 23 ) ) , 'c_relatn' ] ) stopifnot( results[ "HQ-Headquarters of a federation or cooperative" ] == 112 ) stopifnot( results[ "ME-Member of a federation or cooperative" ] == 6859 ) stopifnot( results[ "NO-Not a member of a federation or cooperative" ] == 2236 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for PLS users, this code replicates previously-presented examples: library(dplyr) pls_tbl <- as_tibble( pls_df ) Calculate the mean (average) of a linear variable, overall and by groups: pls_tbl %>% summarize( mean = mean( popu_lsa , na.rm = TRUE ) ) pls_tbl %>% group_by( stabr ) %>% summarize( mean = mean( popu_lsa , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for PLS users, this code replicates previously-presented examples: library(data.table) pls_dt <- data.table( pls_df ) Calculate the mean (average) of a linear variable, overall and by groups: pls_dt[ , mean( popu_lsa , na.rm = TRUE ) ] pls_dt[ , mean( popu_lsa , na.rm = TRUE ) , by = stabr ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for PLS users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'pls' , pls_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( popu_lsa ) FROM pls' ) dbGetQuery( con , 'SELECT stabr , AVG( popu_lsa ) FROM pls GROUP BY stabr' ) "],["pesquisa-nacional-por-amostra-de-domicilios-pnad.html", "Pesquisa Nacional por Amostra de Domicilios (PNAD) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " Pesquisa Nacional por Amostra de Domicilios (PNAD) Brazil’s principal labor force survey, measuring education, employment, income, housing characteristics. One consolidated table with one row per individual within each sampled household. A complex sample survey designed to generalize to the civilian non-institutional population of Brazil. Released quarterly since 2012, with microdata available both quarterly and annually. Administered by the Instituto Brasileiro de Geografia e Estatistica. Please skim before you begin: Conceitos e métodos Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # mineiro data # love verdade gave to me # twelve karaoke.. Download, Import, Preparation Download and import the dictionary file: dictionary_tf <- tempfile() dictionary_url <- paste0( "https://ftp.ibge.gov.br/Trabalho_e_Rendimento/" , "Pesquisa_Nacional_por_Amostra_de_Domicilios_continua/" , "Trimestral/Microdados/Documentacao/Dicionario_e_input_20221031.zip" ) download.file( dictionary_url , dictionary_tf , mode = 'wb' ) dictionary_files <- unzip( dictionary_tf , exdir = tempdir() ) sas_fn <- grep( '\\\\.sas$' , dictionary_files , value = TRUE ) sas_lines <- readLines( sas_fn , encoding = 'latin1' ) Determine fixed-width file positions from the SAS import script: sas_start <- grep( '@0001' , sas_lines ) sas_end <- grep( ';' , sas_lines ) sas_end <- sas_end[ sas_end > sas_start ][ 1 ] sas_lines <- sas_lines[ seq( sas_start , sas_end - 1 ) ] # remove SAS comments sas_lines <- gsub( "\\\\/\\\\*(.*)" , "" , sas_lines ) # remove multiple spaces and spaces at the end of each string sas_lines <- gsub( "( +)" , " " , sas_lines ) sas_lines <- gsub( " $" , "" , sas_lines ) sas_df <- read.table( textConnection( sas_lines ) , sep = ' ' , col.names = c( 'position' , 'column_name' , 'length' ) , header = FALSE ) sas_df[ , 'character' ] <- grepl( '\\\\$' , sas_df[ , 'length' ] ) sas_df[ , 'position' ] <- as.integer( gsub( "\\\\@" , "" , sas_df[ , 'position' ] ) ) sas_df[ , 'length' ] <- as.integer( gsub( "\\\\$" , "" , sas_df[ , 'length' ] ) ) stopifnot( sum( sas_df[ , 'length' ] ) == ( sas_df[ nrow( sas_df ) , 'position' ] + sas_df[ nrow( sas_df ) , 'length' ] - 1 ) ) Download the latest quarterly file: this_tf <- tempfile() this_url <- paste0( "https://ftp.ibge.gov.br/Trabalho_e_Rendimento/" , "Pesquisa_Nacional_por_Amostra_de_Domicilios_continua/" , "Trimestral/Microdados/2023/PNADC_012023.zip" ) download.file( this_url , this_tf , mode = 'wb' ) Import the latest quarterly file: library(readr) pnad_tbl <- read_fwf( this_tf , fwf_widths( widths = sas_df[ , 'length' ] , col_names = sas_df[ , 'column_name' ] ) , col_types = paste0( ifelse( sas_df[ , 'character' ] , "c" , "d" ) , collapse = '' ) ) pnad_df <- data.frame( pnad_tbl ) names( pnad_df ) <- tolower( names( pnad_df ) ) pnad_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # pnad_fn <- file.path( path.expand( "~" ) , "PNAD" , "this_file.rds" ) # saveRDS( pnad_df , file = pnad_fn , compress = FALSE ) Load the same object: # pnad_df <- readRDS( pnad_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) pnad_design <- svrepdesign( data = pnad_df , weight = ~ v1028 , type = 'bootstrap' , repweights = 'v1028[0-9]+' , mse = TRUE , ) Variable Recoding Add new columns to the data set: pnad_design <- update( pnad_design , pia = as.numeric( v2009 >= 14 ) ) pnad_design <- update( pnad_design , ocup_c = ifelse( pia == 1 , as.numeric( vd4002 %in% 1 ) , NA ) , desocup30 = ifelse( pia == 1 , as.numeric( vd4002 %in% 2 ) , NA ) ) pnad_design <- update( pnad_design , uf_name = factor( as.numeric( uf ) , levels = c(11L, 12L, 13L, 14L, 15L, 16L, 17L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 31L, 32L, 33L, 35L, 41L, 42L, 43L, 50L, 51L, 52L, 53L) , labels = c("Rondonia", "Acre", "Amazonas", "Roraima", "Para", "Amapa", "Tocantins", "Maranhao", "Piaui", "Ceara", "Rio Grande do Norte", "Paraiba", "Pernambuco", "Alagoas", "Sergipe", "Bahia", "Minas Gerais", "Espirito Santo", "Rio de Janeiro", "Sao Paulo", "Parana", "Santa Catarina", "Rio Grande do Sul", "Mato Grosso do Sul", "Mato Grosso", "Goias", "Distrito Federal") ) , age_categories = factor( 1 + findInterval( v2009 , seq( 5 , 60 , 5 ) ) ) , male = as.numeric( v2007 == 1 ) , region = substr( uf , 1 , 1 ) , # calculate usual income from main job # (rendimento habitual do trabalho principal) vd4016n = ifelse( pia %in% 1 & vd4015 %in% 1 , vd4016 , NA ) , # calculate effective income from main job # (rendimento efetivo do trabalho principal) vd4017n = ifelse( pia %in% 1 & vd4015 %in% 1 , vd4017 , NA ) , # calculate usual income from all jobs # (variavel rendimento habitual de todos os trabalhos) vd4019n = ifelse( pia %in% 1 & vd4015 %in% 1 , vd4019 , NA ) , # calculate effective income from all jobs # (rendimento efetivo do todos os trabalhos) vd4020n = ifelse( pia %in% 1 & vd4015 %in% 1 , vd4020 , NA ) , # determine the potential labor force pea_c = as.numeric( ocup_c == 1 | desocup30 == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( pnad_design , "sampling" ) != 0 ) svyby( ~ one , ~ uf_name , pnad_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , pnad_design ) svyby( ~ one , ~ uf_name , pnad_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ vd4020n , pnad_design , na.rm = TRUE ) svyby( ~ vd4020n , ~ uf_name , pnad_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ age_categories , pnad_design ) svyby( ~ age_categories , ~ uf_name , pnad_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ vd4020n , pnad_design , na.rm = TRUE ) svyby( ~ vd4020n , ~ uf_name , pnad_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ age_categories , pnad_design ) svyby( ~ age_categories , ~ uf_name , pnad_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ vd4020n , pnad_design , 0.5 , na.rm = TRUE ) svyby( ~ vd4020n , ~ uf_name , pnad_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ ocup_c , denominator = ~ pea_c , pnad_design , na.rm = TRUE ) Subsetting Restrict the survey design to employed persons: sub_pnad_design <- subset( pnad_design , ocup_c == 1 ) Calculate the mean (average) of this subset: svymean( ~ vd4020n , sub_pnad_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ vd4020n , pnad_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ vd4020n , ~ uf_name , pnad_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( pnad_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ vd4020n , pnad_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ vd4020n , pnad_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ vd4020n , pnad_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ male , pnad_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( vd4020n ~ male , pnad_design ) Perform a chi-squared test of association for survey data: svychisq( ~ male + age_categories , pnad_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( vd4020n ~ male + age_categories , pnad_design ) summary( glm_result ) Replication Example This example matches statistics and coefficients of variation from Tabela 4092 - Pessoas de 14 anos ou mais de idade, por condição em relação à força de trabalho e condição de ocupação: nationwide_adult_population <- svytotal( ~ pia , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_adult_population ) / 1000000 , 3 ) == 174.228 ) stopifnot( round( cv( nationwide_adult_population ) / 1000000 , 3 ) == 0 ) nationwide_labor_force <- svytotal( ~ pea_c , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_labor_force ) / 1000000 , 3 ) == 107.257 ) stopifnot( round( cv( nationwide_labor_force ) * 100 , 1 ) == 0.2 ) nationwide_employed <- svytotal( ~ ocup_c , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_employed ) / 1000000 , 3 ) == 97.825 ) stopifnot( round( cv( nationwide_employed ) * 100 , 1 ) == 0.2 ) nationwide_unemployed <- svytotal( ~ desocup30 , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_unemployed ) / 1000000 , 3 ) == 9.432 ) stopifnot( round( cv( nationwide_unemployed ) * 100 , 1 ) == 1.2 ) nationwide_not_in_labor_force <- svytotal( ~ as.numeric( pia & !pea_c ) , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_not_in_labor_force ) / 1000000 , 3 ) == 66.972 ) stopifnot( round( cv( nationwide_not_in_labor_force ) * 100 , 1 ) == 0.3 ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for PNAD users, this code calculates the gini coefficient on complex sample survey data: library(convey) pnad_design <- convey_prep( pnad_design ) svygini( ~ vd4020n , pnad_design , na.rm = TRUE ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for PNAD users, this code replicates previously-presented examples: library(srvyr) pnad_srvyr_design <- as_survey( pnad_design ) Calculate the mean (average) of a linear variable, overall and by groups: pnad_srvyr_design %>% summarize( mean = survey_mean( vd4020n , na.rm = TRUE ) ) pnad_srvyr_design %>% group_by( uf_name ) %>% summarize( mean = survey_mean( vd4020n , na.rm = TRUE ) ) "],["pesquisa-nacional-de-saude-pns.html", "Pesquisa Nacional de Saude (PNS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Pesquisa Nacional de Saude (PNS) Brazil’s health survey, measuring medical conditions, risk behaviors, access to and use of care. One consolidated table with one row per individual within each sampled household. A complex sample survey designed to generalize to Brazil’s civilian population. Released at approximately five year intervals starting in 2013. Administered by Instituto Brasileiro de Geografia e Estatistica partnered with the Ministério da Saúde. Please skim before you begin: Conceitos e métodos Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # cheer the ministry! # with each caipirinha, or # fail sex life module Download, Import, Preparation Download and import the dictionary file: dictionary_tf <- tempfile() dictionary_url <- "https://ftp.ibge.gov.br/PNS/2019/Microdados/Documentacao/Dicionario_e_input_20220530.zip" download.file( dictionary_url , dictionary_tf , mode = 'wb' ) dictionary_files <- unzip( dictionary_tf , exdir = tempdir() ) sas_fn <- grep( '\\\\.sas$' , dictionary_files , value = TRUE ) sas_lines <- readLines( sas_fn , encoding = 'latin1' ) Determine fixed-width file positions from the SAS import script: sas_start <- grep( '@00001' , sas_lines ) sas_end <- grep( ';' , sas_lines ) sas_end <- sas_end[ sas_end > sas_start ][ 1 ] sas_lines <- sas_lines[ seq( sas_start , sas_end - 1 ) ] # remove SAS comments sas_lines <- gsub( "\\\\/\\\\*(.*)" , "" , sas_lines ) # remove tabs, multiple spaces and spaces at the end of each string sas_lines <- gsub( "\\t" , " " , sas_lines ) sas_lines <- gsub( "( +)" , " " , sas_lines ) sas_lines <- gsub( " $" , "" , sas_lines ) sas_df <- read.table( textConnection( sas_lines ) , sep = ' ' , col.names = c( 'position' , 'column_name' , 'length' ) , header = FALSE ) sas_df[ , 'character' ] <- grepl( '\\\\$' , sas_df[ , 'length' ] ) sas_df[ , 'position' ] <- as.integer( gsub( "\\\\@" , "" , sas_df[ , 'position' ] ) ) sas_df[ , 'length' ] <- as.integer( gsub( "\\\\$" , "" , sas_df[ , 'length' ] ) ) stopifnot( sum( sas_df[ , 'length' ] ) == ( sas_df[ nrow( sas_df ) , 'position' ] + sas_df[ nrow( sas_df ) , 'length' ] - 1 ) ) Download the latest data file: this_tf <- tempfile() this_url <- "https://ftp.ibge.gov.br/PNS/2019/Microdados/Dados/PNS_2019_20220525.zip" download.file( this_url , this_tf , mode = 'wb' ) Import the latest data file: library(readr) pns_tbl <- read_fwf( this_tf , fwf_widths( widths = sas_df[ , 'length' ] , col_names = sas_df[ , 'column_name' ] ) , col_types = paste0( ifelse( sas_df[ , 'character' ] , "c" , "d" ) , collapse = '' ) ) pns_df <- data.frame( pns_tbl ) names( pns_df ) <- tolower( names( pns_df ) ) pns_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # pns_fn <- file.path( path.expand( "~" ) , "PNS" , "this_file.rds" ) # saveRDS( pns_df , file = pns_fn , compress = FALSE ) Load the same object: # pns_df <- readRDS( pns_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) pns_prestratified_design <- svydesign( id = ~ upa_pns , strata = ~v0024 , data = subset( pns_df , !is.na( v0028 ) ) , weights = ~v0028 , nest = TRUE ) popc.types <- data.frame( v00283 = as.character( unique( pns_df[ , 'v00283' ] ) ) , Freq = as.numeric( unique( pns_df[ , 'v00282' ] ) ) ) popc.types <- popc.types[ order( popc.types[ , 'v00283' ] ) , ] pns_design <- postStratify( pns_prestratified_design , strata = ~v00283 , population = popc.types ) Variable Recoding Add new columns to the data set: pns_design <- update( pns_design , medical_insurance = ifelse( i00102 %in% 1:2 , as.numeric( i00102 == 1 ) , NA ) , uf_name = factor( as.numeric( v0001 ) , levels = c(11L, 12L, 13L, 14L, 15L, 16L, 17L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 31L, 32L, 33L, 35L, 41L, 42L, 43L, 50L, 51L, 52L, 53L) , labels = c("Rondonia", "Acre", "Amazonas", "Roraima", "Para", "Amapa", "Tocantins", "Maranhao", "Piaui", "Ceara", "Rio Grande do Norte", "Paraiba", "Pernambuco", "Alagoas", "Sergipe", "Bahia", "Minas Gerais", "Espirito Santo", "Rio de Janeiro", "Sao Paulo", "Parana", "Santa Catarina", "Rio Grande do Sul", "Mato Grosso do Sul", "Mato Grosso", "Goias", "Distrito Federal") ) , age_categories = factor( 1 + findInterval( c008 , seq( 5 , 90 , 5 ) ) ) , male = as.numeric( v006 == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( pns_design , "sampling" ) != 0 ) svyby( ~ one , ~ uf_name , pns_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , pns_design ) svyby( ~ one , ~ uf_name , pns_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ e01602 , pns_design , na.rm = TRUE ) svyby( ~ e01602 , ~ uf_name , pns_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ c006 , pns_design ) svyby( ~ c006 , ~ uf_name , pns_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ e01602 , pns_design , na.rm = TRUE ) svyby( ~ e01602 , ~ uf_name , pns_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ c006 , pns_design ) svyby( ~ c006 , ~ uf_name , pns_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ e01602 , pns_design , 0.5 , na.rm = TRUE ) svyby( ~ e01602 , ~ uf_name , pns_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ p00104 , denominator = ~ p00404 , pns_design , na.rm = TRUE ) Subsetting Restrict the survey design to individuals that exercise three or more days per week: sub_pns_design <- subset( pns_design , p035 %in% 3:7 ) Calculate the mean (average) of this subset: svymean( ~ e01602 , sub_pns_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ e01602 , pns_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ e01602 , ~ uf_name , pns_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( pns_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ e01602 , pns_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ e01602 , pns_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ e01602 , pns_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ medical_insurance , pns_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( e01602 ~ medical_insurance , pns_design ) Perform a chi-squared test of association for survey data: svychisq( ~ medical_insurance + c006 , pns_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( e01602 ~ medical_insurance + c006 , pns_design ) summary( glm_result ) Replication Example This example matches Estimando totais of gross monthly income from the official PNSIBGE R package: total_renda <- svytotal( ~ e01602 , pns_design , na.rm = TRUE ) stopifnot( round( coef( total_renda ) , 0 ) == 213227874692 ) stopifnot( round( SE( total_renda ) , 0 ) == 3604489769 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for PNS users, this code replicates previously-presented examples: library(srvyr) pns_srvyr_design <- as_survey( pns_design ) Calculate the mean (average) of a linear variable, overall and by groups: pns_srvyr_design %>% summarize( mean = survey_mean( e01602 , na.rm = TRUE ) ) pns_srvyr_design %>% group_by( uf_name ) %>% summarize( mean = survey_mean( e01602 , na.rm = TRUE ) ) "],["pesquisa-de-orcamentos-familiares-pof.html", "Pesquisa de Orcamentos Familiares (POF) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " Pesquisa de Orcamentos Familiares (POF) Brazil’s household budget survey designed to guide major economic indicators like the Contas nacionais. Various tables with one record per sampled household, resident, job, expenditure. A complex sample survey designed to generalize to the civilian population of Brazil. Released at irregular intervals, 2002-2003, 2008-2009, and 2017-2018 microdata available. Administered by the Instituto Brasileiro de Geografia e Estatistica. Please skim before you begin: Pesquisa de Orçamentos Familiares 2017-2018 Perfil das despesas no Brasil Conceitos e métodos This human-composed haiku or a bouquet of artificial intelligence-generated limericks # shopping na praia # roupa, comida, pede # tres havaianas Download, Import, Preparation Download the dictionary files: library(archive) dictionary_tf <- tempfile() dictionary_url <- paste0( "https://ftp.ibge.gov.br/Orcamentos_Familiares/" , "Pesquisa_de_Orcamentos_Familiares_2017_2018/Microdados/Documentacao_20230713.zip" ) download.file( dictionary_url , dictionary_tf , mode = 'wb' ) dictionary_files <- archive_extract( dictionary_tf , dir = tempdir() ) Import the household variable dictionary: library(readxl) dictionary_fn <- file.path( tempdir() , "Dicionários de váriaveis.xls" ) domicilio_dictionary_tbl <- read_excel( dictionary_fn , sheet = "Domicílio" , skip = 3 ) domicilio_dictionary_df <- data.frame( domicilio_dictionary_tbl ) names( domicilio_dictionary_df ) <- c( 'position' , 'length' , 'decimals' , 'column_name' , 'description' , 'variable_labels' ) domicilio_dictionary_df[ c( 'position' , 'length' , 'decimals' ) ] <- sapply( domicilio_dictionary_df[ c( 'position' , 'length' , 'decimals' ) ] , as.integer ) domicilio_dictionary_df <- subset( domicilio_dictionary_df , !is.na( position ) ) Import the resident variable dictionary: morador_dictionary_tbl <- read_excel( dictionary_fn , sheet = "Morador" , skip = 3 ) morador_dictionary_df <- data.frame( morador_dictionary_tbl ) names( morador_dictionary_df ) <- c( 'position' , 'length' , 'decimals' , 'column_name' , 'description' , 'variable_labels' ) morador_dictionary_df[ c( 'position' , 'length' , 'decimals' ) ] <- sapply( morador_dictionary_df[ c( 'position' , 'length' , 'decimals' ) ] , as.integer ) morador_dictionary_df <- subset( morador_dictionary_df , !is.na( position ) ) Import the post-stratification totals: post_stratification_fn <- file.path( tempdir() , "Pos_estratos_totais.xlsx" ) post_stratification_tbl <- read_excel( post_stratification_fn , skip = 5 ) post_stratification_df <- data.frame( post_stratification_tbl ) names( post_stratification_df ) <- c( 'estrato_pof' , 'pos_estrato' , 'total_pessoas' , 'uf' , 'cod_upa' ) Download the full dataset: this_tf <- tempfile() this_url <- paste0( "https://ftp.ibge.gov.br/Orcamentos_Familiares/" , "Pesquisa_de_Orcamentos_Familiares_2017_2018/Microdados/Dados_20230713.zip" ) download.file( this_url , this_tf , mode = 'wb' ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) Import the household table: library(readr) domicilio_fn <- grep( 'DOMICILIO\\\\.txt$' , unzipped_files , value = TRUE ) domicilio_tbl <- read_fwf( domicilio_fn , fwf_widths( widths = domicilio_dictionary_df[ , 'length' ] , col_names = domicilio_dictionary_df[ , 'column_name' ] ) ) domicilio_df <- data.frame( domicilio_tbl ) names( domicilio_df ) <- tolower( names( domicilio_df ) ) Import the resident table: morador_fn <- grep( 'MORADOR\\\\.txt$' , unzipped_files , value = TRUE ) morador_tbl <- read_fwf( morador_fn , fwf_widths( widths = morador_dictionary_df[ , 'length' ] , col_names = morador_dictionary_df[ , 'column_name' ] ) ) morador_df <- data.frame( morador_tbl ) names( morador_df ) <- tolower( names( morador_df ) ) Merge one household-level variable and also the post-stratification info onto the person-level table: dom_mor_df <- merge( domicilio_df[ c( 'cod_upa' , 'num_dom' , 'v6199' ) ] , morador_df ) pof_df <- merge( dom_mor_df , post_stratification_df ) stopifnot( nrow( pof_df ) == nrow( morador_df ) ) Save locally   Save the object at any point: # pof_fn <- file.path( path.expand( "~" ) , "POF" , "this_file.rds" ) # saveRDS( pof_df , file = pof_fn , compress = FALSE ) Load the same object: # pof_df <- readRDS( pof_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) pre_stratified_design <- svydesign( id = ~ cod_upa , strata = ~ estrato_pof , weights = ~ peso , data = pof_df , nest = TRUE ) population_totals <- aggregate( peso_final ~ pos_estrato , data = pof_df , sum ) names( population_totals ) <- c( 'pos_estrato' , 'Freq' ) pof_design <- postStratify( pre_stratified_design , ~ pos_estrato , population_totals ) Variable Recoding Add new columns to the data set: pof_design <- update( pof_design , one = 1 , food_security = factor( v6199 , levels = 1:4 , labels = c( 'food secure' , 'mild' , 'moderate' , 'severe' ) ) , age_categories = factor( 1 + findInterval( v0403 , c( 20 , 25 , 30 , 35 , 45 , 55 , 65 , 75 ) ) , levels = 1:9 , labels = c( "under 20" , "20-24" , "25-29" , "30-34" , "35-44" , "45-54" , "55-64" , "65-74" , "75+" ) ) , sex = factor( v0404 , levels = 1:2 , labels = c( 'male' , 'female' ) ) , urban = as.numeric( tipo_situacao_reg == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( pof_design , "sampling" ) != 0 ) svyby( ~ one , ~ sex , pof_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , pof_design ) svyby( ~ one , ~ sex , pof_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ renda_total , pof_design ) svyby( ~ renda_total , ~ sex , pof_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ age_categories , pof_design ) svyby( ~ age_categories , ~ sex , pof_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ renda_total , pof_design ) svyby( ~ renda_total , ~ sex , pof_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ age_categories , pof_design ) svyby( ~ age_categories , ~ sex , pof_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ renda_total , pof_design , 0.5 ) svyby( ~ renda_total , ~ sex , pof_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ renda_total , denominator = ~ anos_estudo , pof_design , na.rm = TRUE ) Subsetting Restrict the survey design to credit card holders: sub_pof_design <- subset( pof_design , v0409 > 0 ) Calculate the mean (average) of this subset: svymean( ~ renda_total , sub_pof_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ renda_total , pof_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ renda_total , ~ sex , pof_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( pof_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ renda_total , pof_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ renda_total , pof_design , deff = TRUE ) # SRS with replacement svymean( ~ renda_total , pof_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ urban , pof_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( renda_total ~ urban , pof_design ) Perform a chi-squared test of association for survey data: svychisq( ~ urban + age_categories , pof_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( renda_total ~ urban + age_categories , pof_design ) summary( glm_result ) Replication Example This example matches the 2017-2018 person-level food security estimates from Tabela 3: person_level_food_security <- svymean( ~ food_security , pof_design , na.rm = TRUE ) stopifnot( all.equal( round( coef( person_level_food_security ) , 2 ) , c( 0.59 , 0.27 , 0.09 , 0.05 ) , check.attributes = FALSE ) ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for POF users, this code calculates the gini coefficient on complex sample survey data: library(convey) pof_design <- convey_prep( pof_design ) svygini( ~ renda_total , pof_design , na.rm = TRUE ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for POF users, this code replicates previously-presented examples: library(srvyr) pof_srvyr_design <- as_survey( pof_design ) Calculate the mean (average) of a linear variable, overall and by groups: pof_srvyr_design %>% summarize( mean = survey_mean( renda_total ) ) pof_srvyr_design %>% group_by( sex ) %>% summarize( mean = survey_mean( renda_total ) ) "],["residential-energy-consumption-survey-recs.html", "Residential Energy Consumption Survey (RECS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Residential Energy Consumption Survey (RECS) A periodic study conducted to provide detailed information about energy usage in U.S. homes. One table with one row per sampled housing unit. A complex sample survey designed to generalize to U.S. homes occupied as primary residences. Released approximately every five years since 1979. Prepared by the Energy Information Administration, with help from IMG-Crown and RTI International. Please skim before you begin: Annual Energy Outlook 2023 Household Characteristics Technical Documentation Summary This human-composed haiku or a bouquet of artificial intelligence-generated limericks # housing code dogma # even satan ceased sweat since # eighth sin: central air Download, Import, Preparation Download and import the most recent sas file: library(haven) sas_tf <- tempfile() sas_url <- "https://www.eia.gov/consumption/residential/data/2020/sas/recs2020_public_v2.zip" download.file( sas_url , sas_tf , mode = 'wb' ) recs_tbl <- read_sas( sas_tf ) recs_df <- data.frame( recs_tbl ) names( recs_df ) <- tolower( names( recs_df ) ) recs_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # recs_fn <- file.path( path.expand( "~" ) , "RECS" , "this_file.rds" ) # saveRDS( recs_df , file = recs_fn , compress = FALSE ) Load the same object: # recs_df <- readRDS( recs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) recs_design <- svrepdesign( data = recs_df , weight = ~ nweight , repweights = 'nweight[1-9]+' , type = 'JK1' , combined.weights = TRUE , scale = 59 / 60 , mse = TRUE ) Variable Recoding Add new columns to the data set: recs_design <- update( recs_design , main_heating_fuel = factor( fuelheat , levels = c( -2 , 5 , 1 , 2 , 3 , 7 , 99 ) , labels = c( 'Not applicable' , 'Electricity' , 'Natural gas from underground pipes' , 'Propane (bottled gas)' , 'Fuel oil' , 'Wood or pellets' , 'Other' ) ) , rooftype = factor( rooftype , levels = c( -2 , 1:6 , 99 ) , labels = c( 'Not applicable' , 'Ceramic or clay tiles' , 'Wood shingles/shakes' , 'Metal' , 'Slate or synthetic slate' , 'Shingles (composition or asphalt)' , 'Concrete tiles' , 'Other' ) ) , swimpool_binary = ifelse( swimpool %in% 0:1 , swimpool , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( recs_design , "sampling" ) != 0 ) svyby( ~ one , ~ main_heating_fuel , recs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , recs_design ) svyby( ~ one , ~ main_heating_fuel , recs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ totsqft_en , recs_design ) svyby( ~ totsqft_en , ~ main_heating_fuel , recs_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ rooftype , recs_design ) svyby( ~ rooftype , ~ main_heating_fuel , recs_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ totsqft_en , recs_design ) svyby( ~ totsqft_en , ~ main_heating_fuel , recs_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ rooftype , recs_design ) svyby( ~ rooftype , ~ main_heating_fuel , recs_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ totsqft_en , recs_design , 0.5 ) svyby( ~ totsqft_en , ~ main_heating_fuel , recs_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ totcsqft , denominator = ~ totsqft_en , recs_design ) Subsetting Restrict the survey design to households that cook three or more hot meals per day: sub_recs_design <- subset( recs_design , nummeal == 1 ) Calculate the mean (average) of this subset: svymean( ~ totsqft_en , sub_recs_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ totsqft_en , recs_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ totsqft_en , ~ main_heating_fuel , recs_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( recs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ totsqft_en , recs_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ totsqft_en , recs_design , deff = TRUE ) # SRS with replacement svymean( ~ totsqft_en , recs_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ swimpool_binary , recs_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( totsqft_en ~ swimpool_binary , recs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ swimpool_binary + rooftype , recs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( totsqft_en ~ swimpool_binary + rooftype , recs_design ) summary( glm_result ) Replication Example This example matches the statistic, standard error, and relative standard error shown on PDF page 8 of Using the microdata file to compute estimates and relative standard errors (RSEs) sas_v1_tf <- tempfile() sas_v1_url <- "https://www.eia.gov/consumption/residential/data/2020/sas/recs2020_public_v1.zip" download.file( sas_v1_url , sas_v1_tf , mode = 'wb' ) recs_v1_tbl <- read_sas( sas_v1_tf ) recs_v1_df <- data.frame( recs_v1_tbl ) names( recs_v1_df ) <- tolower( names( recs_v1_df ) ) recs_v1_design <- svrepdesign( data = recs_v1_df , weight = ~ nweight , repweights = 'nweight[1-9]+' , type = 'JK1' , combined.weights = TRUE , scale = 59 / 60 , mse = TRUE ) recs_v1_design <- update( recs_v1_design , natural_gas_mainspace_heat = as.numeric( fuelheat == 1 ) ) result <- svytotal( ~ natural_gas_mainspace_heat , recs_v1_design ) stopifnot( round( coef( result ) , 0 ) == 56245389 ) stopifnot( round( SE( result ) , 0 ) == 545591 ) stopifnot( round( 100 * SE( result ) / coef( result ) , 2 ) == 0.97 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for RECS users, this code replicates previously-presented examples: library(srvyr) recs_srvyr_design <- as_survey( recs_design ) Calculate the mean (average) of a linear variable, overall and by groups: recs_srvyr_design %>% summarize( mean = survey_mean( totsqft_en ) ) recs_srvyr_design %>% group_by( main_heating_fuel ) %>% summarize( mean = survey_mean( totsqft_en ) ) "],["survey-of-business-owners-sbo.html", "Survey of Business Owners (SBO) Function Definitions Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Survey of Business Owners (SBO) Before its replacement in 2018 by the Annual Business Survey, nearly every tax-filing sole proprietorship, partnership, and corporation nationwide completed this questionnaire, with 2007 the only microdata year. One table with one row per firm per state per industry, except eight collapsed geographies. A complex sample survey designed to generalize to most firms in the United States, public microdata includes classifiable (non-identifiable) firms, i.e. nearly all businesses but only about half of workers. Released quinquennially from 1972 until 2012 in the Economic Census with no updates expected. Administered by the U.S. Census Bureau. Annual Business Survey now conducted jointly with the National Center for Science and Engineering Statistics within the National Science Foundation. Please skim before you begin: 2007 Survey of Business Owners (SBO) Public Use Microdata Sample (PUMS) Data Users Guide Comparability to the Annual Business Survey (ABS), the Nonemployer Statistics by Demographics (NES-D) series, and the Annual Survey of Entrepreneurs (ASE) At a Glance This human-composed haiku or a bouquet of artificial intelligence-generated limericks # butchers, chandlers, baked # sea shanty, filial pie # call your mom and pop Function Definitions This survey uses a dual design variance estimation technique described in the Data Users Guide. Most users do not need to study these functions carefully. Define functions specific to only this dataset: sbo_MIcombine <- function( x , adjustment = 1.992065 ){ # pull the structure of a variance-covariance matrix variance.shell <- suppressWarnings( vcov( x$var[[1]] ) ) # initiate a function that will overwrite the diagonals. diag.replacement <- function( z ){ diag( variance.shell ) <- coef( z ) variance.shell } # overwrite all the diagonals in the variance this_design object coef.variances <- lapply( x$var , diag.replacement ) # add then divide by ten midpoint <- Reduce( '+' , coef.variances ) / 10 # initiate another function that takes some object, # subtracts the midpoint, squares it, divides by ninety midpoint.var <- function( z ){ 1/10 * ( ( midpoint - z )^2 / 9 ) } # sum up all the differences into a single object variance <- Reduce( '+' , lapply( coef.variances , midpoint.var ) ) # adjust every number with the factor in the user guide adj_var <- adjustment * variance # construct a result that looks like other sbo_MIcombine methods rval <- list( coefficients = coef( x$coef ) , variance = adj_var ) # call it an MIresult class, like other sbo_MIcombine results class( rval ) <- 'MIresult' rval } sbo_with <- function ( this_design , expr , ... ){ pf <- parent.frame() expr <- substitute( expr ) expr$design <- as.name(".design") # this pulls in means, medians, totals, etc. # notice it uses this_design$coef results <- eval( expr , list( .design = this_design$coef ) ) # this is used to calculate the variance, adjusted variance, standard error # notice it uses the this_design$var object variances <- lapply( this_design$var$designs , function( .design ){ eval( expr , list( .design = .design ) , enclos = pf ) } ) # combine both results.. rval <- list( coef = results , var = variances ) # ..into a brand new object class class( rval ) <- 'imputationResultList' rval } sbo_subset <- function( x , ... ){ # subset the survey object coef.sub <- subset( x$coef , ... ) # replicate `var.sub` so it's got all the same attributes as `x$var` var.sub <- x$var # but then overwrite the `designs` attribute with a subset var.sub$designs <- lapply( x$var$designs , subset , ... ) # now re-create the `sbosvyimputationList` just as before.. sub.svy <- list( coef = coef.sub , var = var.sub ) # ..and give it the same class sub.svy$call <- sys.call(-1) sub.svy } sbo_update <- function( x , ... ){ # update the survey object that's going to be used for # means, medians, totals, etc. coef.upd <- update( x$coef , ... ) # replicate `var.upd` so it's got all the same attributes as `x$var` var.upd <- x$var # but then overwrite the `designs` attribute with an update var.upd$designs <- lapply( x$var$designs , update , ... ) # now re-create the `sbosvyimputationList` just as before upd.svy <- list( coef = coef.upd , var = var.upd ) upd.svy } sbo_degf <- function( x ) degf( x$coef ) Download, Import, Preparation Download and import the file containing records for both coefficient estimates and variance estimation: library(httr) library(readr) tf <- tempfile() this_url <- "https://www2.census.gov/programs-surveys/sbo/datasets/2007/pums_csv.zip" GET( this_url , write_disk( tf ) , progress() ) sbo_tbl <- read_csv( tf ) sbo_df <- data.frame( sbo_tbl ) names( sbo_df ) <- tolower( names( sbo_df ) ) sbo_df[ , 'one' ] <- 1 Calculate the weights used for variance estimation: sbo_df[ , 'newwgt' ] <- 10 * sbo_df[ , 'tabwgt' ] * sqrt( 1 - 1 / sbo_df[ , 'tabwgt' ] ) Add business ownership percentages for both gender and ethnicity: # replace percent missings with zeroes for( i in 1:4 ) sbo_df[ is.na( sbo_df[ , paste0( 'pct' , i ) ] ) , paste0( 'pct' , i ) ] <- 0 # sum up ownership ethnicity and gender sbo_df[ , 'hispanic_pct' ] <- sbo_df[ , 'nonhispanic_pct' ] <- 0 sbo_df[ , 'male_pct' ] <- sbo_df[ , 'female_pct' ] <- 0 # loop through the first four owners' ethnicity and sex variables for( i in 1:4 ) { sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'H' , 'hispanic_pct' ] <- sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'H' , 'hispanic_pct' ] + sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'H' , paste0( 'pct' , i ) ] sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'N' , 'nonhispanic_pct' ] <- sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'N' , 'nonhispanic_pct' ] + sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'N' , paste0( 'pct' , i ) ] sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'M' , 'male_pct' ] <- sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'M' , 'male_pct' ] + sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'M' , paste0( 'pct' , i ) ] sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'F' , 'female_pct' ] <- sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'F' , 'female_pct' ] + sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'F' , paste0( 'pct' , i ) ] } Save locally   Save the object at any point: # sbo_fn <- file.path( path.expand( "~" ) , "SBO" , "this_file.rds" ) # saveRDS( sbo_df , file = sbo_fn , compress = FALSE ) Load the same object: # sbo_df <- readRDS( sbo_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: library(survey) library(mitools) # break random groups into ten separate data.frame objects within a list var_list <- NULL for( i in 1:10 ) { var_list <- c( var_list , list( subset( sbo_df , rg == i ) ) ) } sbo_coef <- svydesign( id = ~ 1 , weight = ~ tabwgt , data = sbo_df ) sbo_var <- svydesign( id = ~ 1 , weight = ~ newwgt , data = imputationList( var_list ) ) sbo_design <- list( coef = sbo_coef , var = sbo_var ) class( sbo_design ) <- 'sbosvyimputationList' Variable Recoding Add new columns to the data set: sbo_design <- sbo_update( sbo_design , established_before_2000 = ifelse( established %in% c( '0' , 'A' ) , NA , as.numeric( established < 4 ) ) , healthins = factor( healthins , levels = 1:2 , labels = c( "offered health insurance" , "did not offer health insurance" ) ) , hispanic_ownership = factor( ifelse( hispanic_pct == nonhispanic_pct , 2 , ifelse( hispanic_pct > nonhispanic_pct , 1 , ifelse( nonhispanic_pct > hispanic_pct , 3 , NA ) ) ) , levels = 1:3 , labels = c( 'hispanic' , 'equally hisp/non' , 'non-hispanic' ) ) , gender_ownership = factor( ifelse( male_pct == female_pct , 2 , ifelse( male_pct > female_pct , 1 , ifelse( female_pct > male_pct , 3 , NA ) ) ) , levels = 1:3 , labels = c( 'male' , 'equally male/female' , 'female' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svyby( ~ one , ~ one , unwtd.count ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ one , ~ gender_ownership , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svytotal( ~ one ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ one , ~ gender_ownership , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svymean( ~ receipts_noisy ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ gender_ownership , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svymean( ~ n07_employer , na.rm = TRUE ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ n07_employer , ~ gender_ownership , svymean , na.rm = TRUE ) ) ) Calculate the sum of a linear variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svytotal( ~ receipts_noisy ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ gender_ownership , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svytotal( ~ n07_employer , na.rm = TRUE ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ n07_employer , ~ gender_ownership , svytotal , na.rm = TRUE ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svyquantile( ~ receipts_noisy , 0.5 , se = TRUE ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ gender_ownership , svyquantile , 0.5 , se = TRUE , ci = TRUE ) ) ) Estimate a ratio: sbo_MIcombine( sbo_with( sbo_design , svyratio( numerator = ~ receipts_noisy , denominator = ~ employment_noisy ) ) ) Subsetting Restrict the survey design to jointly owned by husband and wife: sub_sbo_design <- sbo_subset( sbo_design , husbwife %in% 1:3 ) Calculate the mean (average) of this subset: sbo_MIcombine( sbo_with( sub_sbo_design , svymean( ~ receipts_noisy ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- sbo_MIcombine( sbo_with( sbo_design , svymean( ~ receipts_noisy ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ gender_ownership , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: sbo_degf( sbo_design ) Calculate the complex sample survey-adjusted variance of any statistic: sbo_MIcombine( sbo_with( sbo_design , svyvar( ~ receipts_noisy ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement sbo_MIcombine( sbo_with( sbo_design , svymean( ~ receipts_noisy , deff = TRUE ) ) ) # SRS with replacement sbo_MIcombine( sbo_with( sbo_design , svymean( ~ receipts_noisy , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # # sbo_MIsvyciprop( ~ established_before_2000 , sbo_design , # method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: # # sbo_MIsvyttest( receipts_noisy ~ established_before_2000 , sbo_design ) Perform a chi-squared test of association for survey data: # # sbo_MIsvychisq( ~ established_before_2000 + n07_employer , sbo_design ) Perform a survey-weighted generalized linear model: glm_result <- sbo_MIcombine( sbo_with( sbo_design , svyglm( receipts_noisy ~ established_before_2000 + n07_employer ) ) ) glm_result Replication Example This example matches the statistics and relative standard errors from three Appendix B columns: hispanic_receipts_result <- sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ hispanic_ownership , svytotal ) ) ) hispanic_payroll_result <- sbo_MIcombine( sbo_with( sbo_design , svyby( ~ payroll_noisy , ~ hispanic_ownership , svytotal ) ) ) hispanic_employment_result <- sbo_MIcombine( sbo_with( sbo_design , svyby( ~ employment_noisy , ~ hispanic_ownership , svytotal ) ) ) Estimates at the U.S. Level using the PUMS Tables for: stopifnot( round( coef( hispanic_receipts_result )[ 'hispanic' ] , 0 ) == 350763923 ) stopifnot( round( coef( hispanic_receipts_result )[ 'equally hisp/non' ] , 0 ) == 56166354 ) stopifnot( round( coef( hispanic_receipts_result )[ 'non-hispanic' ] , 0 ) == 10540609303 ) stopifnot( round( coef( hispanic_payroll_result )[ 'hispanic' ] , 0 ) == 54367702 ) stopifnot( round( coef( hispanic_payroll_result )[ 'equally hisp/non' ] , 0 ) == 11083148 ) stopifnot( round( coef( hispanic_payroll_result )[ 'non-hispanic' ] , 0 ) == 1875353228 ) stopifnot( round( coef( hispanic_employment_result )[ 'hispanic' ] , 0 ) == 2026406 ) stopifnot( round( coef( hispanic_employment_result )[ 'equally hisp/non' ] , 0 ) == 400152 ) stopifnot( round( coef( hispanic_employment_result )[ 'non-hispanic' ] , 0 ) == 56889606 ) Relative Standard Errors of Estimates at the U.S. Level using the PUMS Tables for: stopifnot( round( cv( hispanic_receipts_result )[ 'hispanic' ] , 2 ) == 0.02 ) stopifnot( round( cv( hispanic_receipts_result )[ 'equally hisp/non' ] , 2 ) == 0.06 ) stopifnot( round( cv( hispanic_receipts_result )[ 'non-hispanic' ] , 2 ) == 0 ) stopifnot( round( cv( hispanic_payroll_result )[ 'hispanic' ] , 2 ) == 0.01 ) stopifnot( round( cv( hispanic_payroll_result )[ 'equally hisp/non' ] , 2 ) == 0.06 ) stopifnot( round( cv( hispanic_payroll_result )[ 'non-hispanic' ] , 2 ) == 0 ) stopifnot( round( cv( hispanic_employment_result )[ 'hispanic' ] , 2 ) == 0.01 ) stopifnot( round( cv( hispanic_employment_result )[ 'equally hisp/non' ] , 2 ) == 0.05 ) stopifnot( round( cv( hispanic_employment_result )[ 'non-hispanic' ] , 2 ) == 0 ) "],["survey-of-consumer-finances-scf.html", "Survey of Consumer Finances (SCF) Function Definitions Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey  ", " Survey of Consumer Finances (SCF) A comprehensive survey of household wealth, the U.S. central bank studies net worth across the country by asking about both active and passive income, mortgages, pensions, credit card debt, even car leases. Five implicates, each containing one row per sampled household to account for statistical uncertainty. A complex sample survey designed to generalize to the civilian non-institutional U.S. population. Released triennially since 1989. Administered by the Board of Governors of the Federal Reserve System. Please skim before you begin: Measuring Income and Wealth at the Top Using Administrative and Survey Data Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # incomes, assets, debts # high net worth oversample # pig bank laproscope Function Definitions This survey uses a multiply-imputed variance estimation technique described in the 2004 Codebook. Most users do not need to study this function carefully. Define a function specific to only this dataset: scf_MIcombine <- function (results, variances, call = sys.call(), df.complete = Inf, ...) { m <- length(results) oldcall <- attr(results, "call") if (missing(variances)) { variances <- suppressWarnings(lapply(results, vcov)) results <- lapply(results, coef) } vbar <- variances[[1]] cbar <- results[[1]] for (i in 2:m) { cbar <- cbar + results[[i]] # MODIFICATION: # vbar <- vbar + variances[[i]] } cbar <- cbar/m # MODIFICATION: # vbar <- vbar/m evar <- var(do.call("rbind", results)) r <- (1 + 1/m) * evar/vbar df <- (m - 1) * (1 + 1/r)^2 if (is.matrix(df)) df <- diag(df) if (is.finite(df.complete)) { dfobs <- ((df.complete + 1)/(df.complete + 3)) * df.complete * vbar/(vbar + evar) if (is.matrix(dfobs)) dfobs <- diag(dfobs) df <- 1/(1/dfobs + 1/df) } if (is.matrix(r)) r <- diag(r) rval <- list(coefficients = cbar, variance = vbar + evar * (m + 1)/m, call = c(oldcall, call), nimp = m, df = df, missinfo = (r + 2/(df + 3))/(r + 1)) class(rval) <- "MIresult" rval } Download, Import, Preparation Define a function to download and import each stata file: library(haven) scf_dta_import <- function( this_url ){ this_tf <- tempfile() download.file( this_url , this_tf , mode = 'wb' ) this_tbl <- read_dta( this_tf ) this_df <- data.frame( this_tbl ) file.remove( this_tf ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the full, summary extract, and replicate weights tables: scf_df <- scf_dta_import( "https://www.federalreserve.gov/econres/files/scf2022s.zip" ) ext_df <- scf_dta_import( "https://www.federalreserve.gov/econres/files/scfp2022s.zip" ) scf_rw_df <- scf_dta_import( "https://www.federalreserve.gov/econres/files/scf2022rw1s.zip" ) Confirm both the full public data and the summary extract contain five records per family: stopifnot( nrow( scf_df ) == nrow( scf_rw_df ) * 5 ) stopifnot( nrow( scf_df ) == nrow( ext_df ) ) Confirm only the primary economic unit and the five implicate identifiers overlap: stopifnot( all( sort( intersect( names( scf_df ) , names( ext_df ) ) ) == c( 'y1' , 'yy1' ) ) ) stopifnot( all( sort( intersect( names( scf_df ) , names( scf_rw_df ) ) ) == c( 'y1' , 'yy1' ) ) ) stopifnot( all( sort( intersect( names( ext_df ) , names( scf_rw_df ) ) ) == c( 'y1' , 'yy1' ) ) ) Remove the implicate identifier from the replicate weights table, add a column of fives for weighting: scf_rw_df[ , 'y1' ] <- NULL scf_df[ , 'five' ] <- 5 Save locally   Save the object at any point: # scf_fn <- file.path( path.expand( "~" ) , "SCF" , "this_file.rds" ) # saveRDS( scf_df , file = scf_fn , compress = FALSE ) Load the same object: # scf_df <- readRDS( scf_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: Break the main table into five different implicates based on the final character of the column y1: library(stringr) s1_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 1 , ] s2_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 2 , ] s3_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 3 , ] s4_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 4 , ] s5_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 5 , ] Combine these into a single list, then merge each implicate with the summary extract: scf_imp <- list( s1_df , s2_df , s3_df , s4_df , s5_df ) scf_list <- lapply( scf_imp , merge , ext_df ) Replace all missing values in the replicate weights table with zeroes, multiply the replicate weights by the multiplication factor, then only keep the unique identifier and the final (combined) replicate weights: scf_rw_df[ is.na( scf_rw_df ) ] <- 0 scf_rw_df[ , paste0( 'wgt' , 1:999 ) ] <- scf_rw_df[ , paste0( 'wt1b' , 1:999 ) ] * scf_rw_df[ , paste0( 'mm' , 1:999 ) ] scf_rw_df <- scf_rw_df[ , c( 'yy1' , paste0( 'wgt' , 1:999 ) ) ] Sort both the five implicates and also the replicate weights table by the unique identifier: scf_list <- lapply( scf_list , function( w ) w[ order( w[ , 'yy1' ] ) , ] ) scf_rw_df <- scf_rw_df[ order( scf_rw_df[ , 'yy1' ] ) , ] Define the design: library(survey) library(mitools) scf_design <- svrepdesign( weights = ~wgt , repweights = scf_rw_df[ , -1 ] , data = imputationList( scf_list ) , scale = 1 , rscales = rep( 1 / 998 , 999 ) , mse = FALSE , type = "other" , combined.weights = TRUE ) Variable Recoding Add new columns to the data set: scf_design <- update( scf_design , hhsex = factor( hhsex , levels = 1:2 , labels = c( "male" , "female" ) ) , married = as.numeric( married == 1 ) , edcl = factor( edcl , levels = 1:4 , labels = c( "less than high school" , "high school or GED" , "some college" , "college degree" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: scf_MIcombine( with( scf_design , svyby( ~ five , ~ five , unwtd.count ) ) ) scf_MIcombine( with( scf_design , svyby( ~ five , ~ hhsex , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: scf_MIcombine( with( scf_design , svytotal( ~ five ) ) ) scf_MIcombine( with( scf_design , svyby( ~ five , ~ hhsex , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: scf_MIcombine( with( scf_design , svymean( ~ networth ) ) ) scf_MIcombine( with( scf_design , svyby( ~ networth , ~ hhsex , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: scf_MIcombine( with( scf_design , svymean( ~ edcl ) ) ) scf_MIcombine( with( scf_design , svyby( ~ edcl , ~ hhsex , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: scf_MIcombine( with( scf_design , svytotal( ~ networth ) ) ) scf_MIcombine( with( scf_design , svyby( ~ networth , ~ hhsex , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: scf_MIcombine( with( scf_design , svytotal( ~ edcl ) ) ) scf_MIcombine( with( scf_design , svyby( ~ edcl , ~ hhsex , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: scf_MIcombine( with( scf_design , svyquantile( ~ networth , 0.5 , se = TRUE , interval.type = 'quantile' ) ) ) scf_MIcombine( with( scf_design , svyby( ~ networth , ~ hhsex , svyquantile , 0.5 , se = TRUE , interval.type = 'quantile' , ci = TRUE ) ) ) Estimate a ratio: scf_MIcombine( with( scf_design , svyratio( numerator = ~ income , denominator = ~ networth ) ) ) Subsetting Restrict the survey design to labor force participants: sub_scf_design <- subset( scf_design , lf == 1 ) Calculate the mean (average) of this subset: scf_MIcombine( with( sub_scf_design , svymean( ~ networth ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- scf_MIcombine( with( scf_design , svymean( ~ networth ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- scf_MIcombine( with( scf_design , svyby( ~ networth , ~ hhsex , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( scf_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: scf_MIcombine( with( scf_design , svyvar( ~ networth ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement scf_MIcombine( with( scf_design , svymean( ~ networth , deff = TRUE ) ) ) # SRS with replacement scf_MIcombine( with( scf_design , svymean( ~ networth , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ married , scf_design , # method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( networth ~ married , scf_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ married + edcl , scf_design ) Perform a survey-weighted generalized linear model: glm_result <- scf_MIcombine( with( scf_design , svyglm( networth ~ married + edcl ) ) ) summary( glm_result ) Replication Example This example matches the “Table 4” tab’s cell Y6 of the Excel Based on Public Data: mean_net_worth <- scf_MIcombine( with( scf_design , svymean( ~ networth ) ) ) stopifnot( round( coef( mean_net_worth ) / 1000 , 1 ) == 1059.5 ) This example comes within $500 of the standard error of mean net worth from Table 2 of the Federal Reserve Bulletin, displaying the minor differences between the Internal Data and Public Data: stopifnot( abs( 23.2 - round( SE( mean_net_worth ) / 1000 , 1 ) ) < 0.5 ) This example matches the “Table 4” tab’s cells X6 of the Excel Based on Public Data: # compute quantile with all five implicates stacked (not the recommended technique) fake_design <- svydesign( ~ 1 , data = ext_df[ c( 'networth' , 'wgt' ) ] , weights = ~ wgt ) median_net_worth_incorrect_errors <- svyquantile( ~ networth , fake_design , 0.5 ) stopifnot( round( coef( median_net_worth_incorrect_errors ) / 1000 , 2 ) == 192.7 ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for SCF users, this code calculates the gini coefficient on complex sample survey data: library(convey) scf_design$designs <- lapply( scf_design$designs , convey_prep ) scf_MIcombine( with( scf_design , svygini( ~ networth ) ) ) "],["survey-of-income-and-program-participation-sipp.html", "Survey of Income and Program Participation (SIPP) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " Survey of Income and Program Participation (SIPP) The primary longitudinal assessment of income fluctuation, labor force participation, social programs. Annual tables with one record per month per person per sampled household, time period weights. A complex sample generalizing to the U.S. civilian non-institutionalized across varying time periods. Multi-year panels since 1980s, its current and now permanent four year rotation beginning in 2018. Administered and financed by the US Census Bureau. Please skim before you begin: 2022 Survey of Income and Program Participation Users’ Guide 2022 Data User Notes This human-composed haiku or a bouquet of artificial intelligence-generated limericks # federal programs # poverty oversample # monthly dynamics Download, Import, Preparation Determine which variables from the main table to import: variables_to_keep <- c( 'ssuid' , 'pnum' , 'monthcode' , 'spanel' , 'swave' , 'erelrpe' , 'tlivqtr' , 'wpfinwgt' , 'rmesr' , 'thcyincpov' , 'tfcyincpov' , 'tehc_st' , 'rhicovann' , 'rfpov' , 'thnetworth' , 'tftotinc' ) Download and import the latest main file: library(httr) library(data.table) main_tf <- tempfile() main_url <- paste0( "https://www2.census.gov/programs-surveys/sipp/" , "data/datasets/2022/pu2022_csv.zip" ) GET( main_url , write_disk( main_tf ) , progress() ) main_csv <- unzip( main_tf , exdir = tempdir() ) sipp_main_dt <- fread( main_csv , sep = "|" , select = toupper( variables_to_keep ) ) sipp_main_df <- data.frame( sipp_main_dt ) names( sipp_main_df ) <- tolower( names( sipp_main_df ) ) Download and import the appropriate replicate weights file: rw_tf <- tempfile() rw_url <- paste0( "https://www2.census.gov/programs-surveys/sipp/" , "data/datasets/2022/rw2022_csv.zip" ) GET( rw_url , write_disk( rw_tf ) , progress() ) rw_csv <- unzip( rw_tf , exdir = tempdir() ) sipp_rw_dt <- fread( rw_csv , sep = "|" ) sipp_rw_df <- data.frame( sipp_rw_dt ) names( sipp_rw_df ) <- tolower( names( sipp_rw_df ) ) Limit both files to December records for a point-in-time estimate, then merge: sipp_df <- merge( sipp_main_df[ sipp_main_df[ , 'monthcode' ] %in% 12 , ] , sipp_rw_df[ sipp_rw_df[ , 'monthcode' ] %in% 12 , ] , by = c( 'ssuid' , 'pnum' , 'monthcode' , 'spanel' , 'swave' ) ) stopifnot( nrow( sipp_df ) == sum( sipp_rw_df[ , 'monthcode' ] %in% 12 ) ) Save locally   Save the object at any point: # sipp_fn <- file.path( path.expand( "~" ) , "SIPP" , "this_file.rds" ) # saveRDS( sipp_df , file = sipp_fn , compress = FALSE ) Load the same object: # sipp_df <- readRDS( sipp_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) sipp_design <- svrepdesign( data = sipp_df , weights = ~ wpfinwgt , repweights = "repwgt([1-9]+)" , type = "Fay" , rho = 0.5 ) Variable Recoding Add new columns to the data set: rmesr_values <- c( "With a job entire month, worked all weeks", "With a job all month, absent from work without pay 1+ weeks, absence not due to layoff", "With a job all month, absent from work without pay 1+ weeks, absence due to layoff", "With a job at least 1 but not all weeks, no time on layoff and no time looking for work", "With a job at least 1 but not all weeks, some weeks on layoff or looking for work", "No job all month, on layoff or looking for work all weeks", "No job all month, at least one but not all weeks on layoff or looking for work", "No job all month, no time on layoff and no time looking for work" ) sipp_design <- update( sipp_design , one = 1 , employment_status = factor( rmesr , levels = 1:8 , labels = rmesr_values ) , household_below_poverty = as.numeric( thcyincpov < 1 ) , family_below_poverty = as.numeric( tfcyincpov < 1 ) , state_name = factor( as.numeric( tehc_st ) , levels = c(1L, 2L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 12L, 13L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 53L, 54L, 55L, 56L, 60L, 61L) , labels = c("Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "District of Columbia", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming", "Puerto Rico", "Foreign Country") ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( sipp_design , "sampling" ) != 0 ) svyby( ~ one , ~ state_name , sipp_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , sipp_design ) svyby( ~ one , ~ state_name , sipp_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ tftotinc , sipp_design , na.rm = TRUE ) svyby( ~ tftotinc , ~ state_name , sipp_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ employment_status , sipp_design , na.rm = TRUE ) svyby( ~ employment_status , ~ state_name , sipp_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ tftotinc , sipp_design , na.rm = TRUE ) svyby( ~ tftotinc , ~ state_name , sipp_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ employment_status , sipp_design , na.rm = TRUE ) svyby( ~ employment_status , ~ state_name , sipp_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ tftotinc , sipp_design , 0.5 , na.rm = TRUE ) svyby( ~ tftotinc , ~ state_name , sipp_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ tftotinc , denominator = ~ rfpov , sipp_design , na.rm = TRUE ) Subsetting Restrict the survey design to individuals ever covered by health insurance during the year: sub_sipp_design <- subset( sipp_design , rhicovann == 1 ) Calculate the mean (average) of this subset: svymean( ~ tftotinc , sub_sipp_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ tftotinc , sipp_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ tftotinc , ~ state_name , sipp_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( sipp_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ tftotinc , sipp_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ tftotinc , sipp_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ tftotinc , sipp_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ family_below_poverty , sipp_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( tftotinc ~ family_below_poverty , sipp_design ) Perform a chi-squared test of association for survey data: svychisq( ~ family_below_poverty + employment_status , sipp_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( tftotinc ~ family_below_poverty + employment_status , sipp_design ) summary( glm_result ) Replication Example This example matches statistics and standard errors from the Wealth and Asset Ownership for Households, by Type of Asset and Selected Characteristics: 2021: Restrict the design to permanent residence-based householders to match the count in Table 4: sipp_household_design <- subset( sipp_design , erelrpe %in% 1:2 & tlivqtr %in% 1:2 ) stopifnot( round( coef( svytotal( ~ one , sipp_household_design ) ) / 1000 , -2 ) == 132700 ) Compute Household Net Worth distribution and standard errors across the Total row of Tables 4 and 4A: sipp_household_design <- update( sipp_household_design , thnetworth_category = factor( findInterval( thnetworth , c( 1 , 5000 , 10000 , 25000 , 50000 , 100000 , 250000 , 500000 ) ) , levels = 0:8 , labels = c( "Zero or Negative" , "$1 to $4,999" , "$5,000 to $9,999" , "$10,000 to $24,999" , "$25,000 to $49,999" , "$50,000 to $99,999" , "$100,000 to $249,999" , "$250,000 to $499,999" , "$500,000 or over" ) ) ) results <- svymean( ~ thnetworth_category , sipp_household_design ) stopifnot( all.equal( as.numeric( round( coef( results ) * 100 , 1 ) ) , c( 11.3 , 6.9 , 3.5 , 5.9 , 6.4 , 8.2 , 15.3 , 13.9 , 28.7 ) ) ) stopifnot( all.equal( as.numeric( round( SE( results ) * 100 , 1 ) ) , c( 0.3 , 0.2 , 0.2 , 0.2 , 0.2 , 0.2 , 0.3 , 0.3 , 0.3 ) ) ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for SIPP users, this code calculates the gini coefficient on complex sample survey data: library(convey) sipp_design <- convey_prep( sipp_design ) svygini( ~ tftotinc , sipp_design , na.rm = TRUE ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for SIPP users, this code replicates previously-presented examples: library(srvyr) sipp_srvyr_design <- as_survey( sipp_design ) Calculate the mean (average) of a linear variable, overall and by groups: sipp_srvyr_design %>% summarize( mean = survey_mean( tftotinc , na.rm = TRUE ) ) sipp_srvyr_design %>% group_by( state_name ) %>% summarize( mean = survey_mean( tftotinc , na.rm = TRUE ) ) "],["social-security-public-use-data-files-ssa.html", "Social Security Public-Use Data Files (SSA) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Social Security Public-Use Data Files (SSA) Microdata from administrative sources like the Master Beneficiary Record, Supplemental Security Record. Tables contain either one record per person or one record per person per year. A systematic sample of either social security number holders (most americans) or program recipients (current beneficiaries). Multiply 1% samples by 100 to get weighted statistics, 5% samples by 20. No expected release timeline. Released by the Office of Research, Evaluation, and Statistics, US Social Security Administration. Please skim before you begin: The 2006 Earnings Public-Use Microdata File: An Introduction Comparing Earnings Estimates from the 2006 Public-Use File and the Annual Statistical Supplement This human-composed haiku or a bouquet of artificial intelligence-generated limericks # annual earnings. # for pensioner payouts, see # the '04 extract Download, Import, Preparation Download and import the 1951-2006 one percent files with one record per person and per person-year: library(haven) library(httr) tf <- tempfile() ssa_url <- "https://www.ssa.gov/policy/docs/microdata/epuf/epuf2006_sas_files.zip" GET( ssa_url , write_disk( tf ) , progress() ) ssa_files <- unzip( tf , exdir = tempdir() ) ssa_fn <- grep( 'demographic' , ssa_files , value = TRUE ) annual_fn <- grep( 'annual' , ssa_files , value = TRUE ) ssa_tbl <- read_sas( ssa_fn ) annual_tbl <- read_sas( annual_fn ) ssa_df <- data.frame( ssa_tbl ) annual_df <- data.frame( annual_tbl ) names( ssa_df ) <- tolower( names( ssa_df ) ) names( annual_df ) <- tolower( names( annual_df ) ) Sum up 1951-1952 and 1953-2006 earnings, and also 1953-2006 credits, copying the naming convention: summed_earnings_5152 <- with( subset( annual_df , year_earn %in% 1951:1952 ) , aggregate( annual_earnings , list( id ) , sum ) ) names( summed_earnings_5152 ) <- c( 'id' , 'tot_cov_earn5152' ) summed_earnings_5306 <- with( subset( annual_df , year_earn > 1952 ) , aggregate( annual_earnings , list( id ) , sum ) ) names( summed_earnings_5306 ) <- c( 'id' , 'tot_cov_earn5306' ) summed_quarters_5306 <- with( subset( annual_df , year_earn > 1952 ) , aggregate( annual_qtrs , list( id ) , sum ) ) names( summed_quarters_5306 ) <- c( 'id' , 'qc5306' ) Isolate a single year of earnings: earnings_2006 <- annual_df[ annual_df[ , 'year_earn' ] == 2006 , c( 'id' , 'annual_earnings' ) ] names( earnings_2006 ) <- c( 'id' , 'tot_cov_earn06' ) Merge each new column on to the person-level table, then add zeroes to person-years without earnings: stopifnot( all( !is.na( ssa_df ) ) ) before_nrow <- nrow( ssa_df ) ssa_df <- merge( ssa_df , summed_earnings_5152 , all.x = TRUE ) ssa_df <- merge( ssa_df , summed_earnings_5306 , all.x = TRUE ) ssa_df <- merge( ssa_df , summed_quarters_5306 , all.x = TRUE ) ssa_df <- merge( ssa_df , earnings_2006 , all.x = TRUE ) ssa_df[ is.na( ssa_df ) ] <- 0 stopifnot( nrow( ssa_df ) == before_nrow ) Save locally   Save the object at any point: # ssa_fn <- file.path( path.expand( "~" ) , "SSA" , "this_file.rds" ) # saveRDS( ssa_df , file = ssa_fn , compress = FALSE ) Load the same object: # ssa_df <- readRDS( ssa_fn ) Variable Recoding Add new columns to the data set: ssa_df <- transform( ssa_df , decade_of_birth = floor( yob / 10 ) * 10 , sex = factor( sex , levels = 1:2 , labels = c( 'male' , 'female' ) ) , tot_cov_earn3706 = ( tot_cov_earn3750 + tot_cov_earn5152 + tot_cov_earn5306 ) , qc3706 = ( qc3750 + qc5152 + qc5306 ) , any_earnings_2006 = ( tot_cov_earn06 > 0 ) , earnings_periods = factor( ifelse( ( tot_cov_earn5152 + tot_cov_earn5306 > 0 ) & tot_cov_earn3750 > 0 , 1 , ifelse( tot_cov_earn5152 > 0 | tot_cov_earn5306 > 0 , 2 , ifelse( tot_cov_earn3750 > 0 , 3 , 4 ) ) ) , levels = 1:4 , labels = c( 'Earnings in both periods' , 'Earnings during 1951-2006 only' , 'Earnings during 1937-1950 only' , 'No earnings' ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( ssa_df ) table( ssa_df[ , "sex" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( ssa_df[ , "tot_cov_earn3706" ] ) tapply( ssa_df[ , "tot_cov_earn3706" ] , ssa_df[ , "sex" ] , mean ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( ssa_df[ , "decade_of_birth" ] ) ) prop.table( table( ssa_df[ , c( "decade_of_birth" , "sex" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( ssa_df[ , "tot_cov_earn3706" ] ) tapply( ssa_df[ , "tot_cov_earn3706" ] , ssa_df[ , "sex" ] , sum ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( ssa_df[ , "tot_cov_earn3706" ] , 0.5 ) tapply( ssa_df[ , "tot_cov_earn3706" ] , ssa_df[ , "sex" ] , quantile , 0.5 ) Subsetting Limit your data.frame to individuals with at least forty lifetime credits: sub_ssa_df <- subset( ssa_df , qc3706 >= 40 ) Calculate the mean (average) of this subset: mean( sub_ssa_df[ , "tot_cov_earn3706" ] ) Measures of Uncertainty Calculate the variance, overall and by groups: var( ssa_df[ , "tot_cov_earn3706" ] ) tapply( ssa_df[ , "tot_cov_earn3706" ] , ssa_df[ , "sex" ] , var ) Regression Models and Tests of Association Perform a t-test: t.test( tot_cov_earn3706 ~ any_earnings_2006 , ssa_df ) Perform a chi-squared test of association: this_table <- table( ssa_df[ , c( "any_earnings_2006" , "decade_of_birth" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( tot_cov_earn3706 ~ any_earnings_2006 + decade_of_birth , data = ssa_df ) summary( glm_result ) Replication Example This example matches statistics in The 2006 Earnings Public-Use Microdata File: An Introduction: Chart 5. Percentage distribution of individuals in EPUF, by capped Social Security taxable earnings status: chart_five_results <- prop.table( table( ssa_df[ , 'earnings_periods' ] ) ) chart_five_results <- round( 100 * chart_five_results ) stopifnot( chart_five_results[ 'Earnings in both periods' ] == 16 ) stopifnot( chart_five_results[ 'Earnings during 1951-2006 only' ] == 55 ) stopifnot( chart_five_results[ 'Earnings during 1937-1950 only' ] == 4 ) stopifnot( chart_five_results[ 'No earnings' ] == 25 ) Table 4. Average and median Social Security taxable earnings in EPUF, by sex, 1951–2006 (in dollars): nonzero_2006_earners <- ssa_df[ ssa_df[ , 'tot_cov_earn06' ] > 0 , 'tot_cov_earn06' ] stopifnot( round( mean( nonzero_2006_earners ) , 0 ) == 30953 ) stopifnot( round( quantile( nonzero_2006_earners )[ 3 ] , 0 ) == 24000 ) Table A1. Number and percentage distribution of individuals with Social Security taxable earnings records in EPUF, by sex, 1951–2006: nonzero_2006_earners <- ssa_df[ ssa_df[ , 'tot_cov_earn06' ] > 0 , ] stopifnot( round( mean( nonzero_2006_earners[ , 'tot_cov_earn06' ] ) , 0 ) == 30953 ) stopifnot( round( quantile( nonzero_2006_earners[ , 'tot_cov_earn06' ] )[ 3 ] , 0 ) == 24000 ) This example matches statistics in Comparing Earnings Estimates from the 2006 Earnings Public-Use File and the Annual Statistical Supplement: Table 4. Comparing Supplement and EPUF estimates: Number of all, male, and female workers with any earnings during the year, 1951–2006: stopifnot( round( nrow( nonzero_2006_earners ) * 100 , -3 ) == 156280000 ) earners_in_2006_by_sex <- table( nonzero_2006_earners[ , 'sex' ] ) * 100 stopifnot( round( earners_in_2006_by_sex[ 'male' ] , -3 ) == 81576000 ) stopifnot( round( earners_in_2006_by_sex[ 'female' ] , -3 ) == 74681000 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for SSA users, this code replicates previously-presented examples: library(dplyr) ssa_tbl <- as_tibble( ssa_df ) Calculate the mean (average) of a linear variable, overall and by groups: ssa_tbl %>% summarize( mean = mean( tot_cov_earn3706 ) ) ssa_tbl %>% group_by( sex ) %>% summarize( mean = mean( tot_cov_earn3706 ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for SSA users, this code replicates previously-presented examples: library(data.table) ssa_dt <- data.table( ssa_df ) Calculate the mean (average) of a linear variable, overall and by groups: ssa_dt[ , mean( tot_cov_earn3706 ) ] ssa_dt[ , mean( tot_cov_earn3706 ) , by = sex ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for SSA users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'ssa' , ssa_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( tot_cov_earn3706 ) FROM ssa' ) dbGetQuery( con , 'SELECT sex , AVG( tot_cov_earn3706 ) FROM ssa GROUP BY sex' ) "],["trends-in-international-mathematics-and-science-study-timss.html", "Trends in International Mathematics and Science Study (TIMSS) Function Definitions Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Trends in International Mathematics and Science Study (TIMSS) A comparative study of student achievement in math and science across more than 50 nations. Grade-specific tables with one record per school, student, teacher, plus files containing student achievement, home background, student-teacher linkage, and within-country scoring reliability. A complex survey generalizing to fourth- and eighth-grade populations of participating countries. Released quadrennially since 1995. Funded by the International Association for the Evaluation of Educational Achievement, run at BC. Please skim before you begin: TIMSS 2019 User Guide for the International Database, 2nd Edition Methods and Procedures: TIMSS 2019 Technical Report This human-composed haiku or a bouquet of artificial intelligence-generated limericks # brando for stella, # gump's jenny, rock's adrian, # students toward math test Function Definitions This survey uses a multiply-imputed variance estimation technique described in Methods Chapter 14. Most users do not need to study this function carefully. Define a function specific to only this dataset: timss_MIcombine <- function (results, variances, call = sys.call(), df.complete = Inf, ...) { m <- length(results) oldcall <- attr(results, "call") if (missing(variances)) { variances <- suppressWarnings(lapply(results, vcov)) results <- lapply(results, coef) } vbar <- variances[[1]] cbar <- results[[1]] for (i in 2:m) { cbar <- cbar + results[[i]] vbar <- vbar + variances[[i]] } cbar <- cbar/m vbar <- vbar/m # MODIFICATION # evar <- var(do.call("rbind", results)) evar <- sum( ( unlist( results ) - cbar )^2 / 4 ) r <- (1 + 1/m) * evar/vbar df <- (m - 1) * (1 + 1/r)^2 if (is.matrix(df)) df <- diag(df) if (is.finite(df.complete)) { dfobs <- ((df.complete + 1)/(df.complete + 3)) * df.complete * vbar/(vbar + evar) if (is.matrix(dfobs)) dfobs <- diag(dfobs) df <- 1/(1/dfobs + 1/df) } if (is.matrix(r)) r <- diag(r) rval <- list(coefficients = cbar, variance = vbar + evar * (m + 1)/m, call = c(oldcall, call), nimp = m, df = df, missinfo = (r + 2/(df + 3))/(r + 1)) class(rval) <- "MIresult" rval } Download, Import, Preparation Download and unzip the 2019 fourth grade international database: library(httr) tf <- tempfile() this_url <- "https://timss2019.org/international-database/downloads/T19_G4_SPSS%20Data.zip" GET( this_url , write_disk( tf ) , progress() ) unzipped_files <- unzip( tf , exdir = tempdir() ) Import and stack each of the student context data files for Albania through Canada: library(haven) # limit unzipped files to those starting with `asg` followed by three letters followed by `m7` asg_fns <- unzipped_files[ grepl( '^asg[a-z][a-z][a-z]m7' , basename( unzipped_files ) ) ] # further limit asg files to the first ten countries countries_thru_canada <- c("alb", "arm", "aus", "aut", "aze", "bhr", "bfl", "bih", "bgr", "can") fns_thru_canada <- paste0( paste0( '^asg' , countries_thru_canada , 'm7' ) , collapse = "|" ) asg_alb_can_fns <- asg_fns[ grepl( fns_thru_canada , basename( asg_fns ) ) ] timss_df <- NULL for( spss_fn in asg_alb_can_fns ){ this_tbl <- read_spss( spss_fn ) this_tbl <- zap_labels( this_tbl ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) timss_df <- rbind( timss_df , this_df ) } # order the data.frame by unique student id timss_df <- timss_df[ with( timss_df , order( idcntry , idstud ) ) , ] Save locally   Save the object at any point: # timss_fn <- file.path( path.expand( "~" ) , "TIMSS" , "this_file.rds" ) # saveRDS( timss_df , file = timss_fn , compress = FALSE ) Load the same object: # timss_df <- readRDS( timss_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: From among possibly plausible values, determine all columns that are multiply-imputed plausible values: # identify all columns ending with `01` thru `05` ppv <- grep( "(.*)0[1-5]$" , names( timss_df ) , value = TRUE ) # remove those ending digits ppv_prefix <- gsub( "0[1-5]$" , "" , ppv ) # identify each of the possibilities with exactly five matches (five implicates) pv <- names( table( ppv_prefix )[ table( ppv_prefix ) == 5 ] ) # identify each of the `01` thru `05` plausible value columns pv_columns <- grep( paste0( "^" , pv , "0[1-5]$" , collapse = "|" ) , names( timss_df ) , value = TRUE ) Extract those multiply-imputed columns into a separate data.frame, then remove them from the source: pv_wide_df <- timss_df[ c( 'idcntry' , 'idstud' , pv_columns ) ] timss_df[ pv_columns ] <- NULL Reshape these columns from one record per student to one record per student per implicate: pv_long_df <- reshape( pv_wide_df , varying = lapply( paste0( pv , '0' ) , paste0 , 1:5 ) , direction = 'long' , timevar = 'implicate' , idvar = c( 'idcntry' , 'idstud' ) ) names( pv_long_df ) <- gsub( "01$" , "" , names( pv_long_df ) ) Merge the columns from the source data.frame onto the one record per student per implicate data.frame: timss_long_df <- merge( timss_df , pv_long_df ) timss_long_df <- timss_long_df[ with( timss_long_df , order( idcntry , idstud ) ) , ] stopifnot( nrow( timss_long_df ) == nrow( pv_long_df ) ) stopifnot( nrow( timss_long_df ) / 5 == nrow( timss_df ) ) Divide the five plausible value implicates into a list with five data.frames based on the implicate number: timss_list <- split( timss_long_df , timss_long_df[ , 'implicate' ] ) Construct a replicate weights table following the estimation technique described in Methods Chapter 14: weights_df <- timss_df[ c( 'jkrep' , 'jkzone' ) ] for( j in 1:75 ){ for( i in 0:1 ){ weights_df[ weights_df[ , 'jkzone' ] != j , paste0( 'rw' , i , j ) ] <- 1 weights_df[ weights_df[ , 'jkzone' ] == j , paste0( 'rw' , i , j ) ] <- 2 * ( weights_df[ weights_df[ , 'jkzone' ] == j , 'jkrep' ] == i ) } } weights_df[ c( 'jkrep' , 'jkzone' ) ] <- NULL Define the design: library(survey) library(mitools) timss_design <- svrepdesign( weights = ~totwgt , repweights = weights_df , data = imputationList( timss_list ) , type = "other" , scale = 0.5 , rscales = rep( 1 , 150 ) , combined.weights = FALSE , mse = TRUE ) Variable Recoding Add new columns to the data set: timss_design <- update( timss_design , one = 1 , countries_thru_canada = factor( as.numeric( idcntry ) , levels = c(8L, 51L, 36L, 40L, 31L, 48L, 956L, 70L, 100L, 124L) , labels = c("Albania", "Armenia", "Australia", "Austria", "Azerbaijan", "Bahrain", "Belgium (Flemish)", "Bosnia and Herzegovina", "Bulgaria", "Canada") ) , sex = factor( asbg01 , levels = 1:2 , labels = c( "female" , "male" ) ) , born_in_country = ifelse( asbg07 %in% 1:2 , as.numeric( asbg07 == 1 ) , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: timss_MIcombine( with( timss_design , svyby( ~ one , ~ one , unwtd.count ) ) ) timss_MIcombine( with( timss_design , svyby( ~ one , ~ sex , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: timss_MIcombine( with( timss_design , svytotal( ~ one ) ) ) timss_MIcombine( with( timss_design , svyby( ~ one , ~ sex , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: timss_MIcombine( with( timss_design , svymean( ~ asmmat , na.rm = TRUE ) ) ) timss_MIcombine( with( timss_design , svyby( ~ asmmat , ~ sex , svymean , na.rm = TRUE ) ) ) Calculate the distribution of a categorical variable, overall and by groups: timss_MIcombine( with( timss_design , svymean( ~ countries_thru_canada ) ) ) timss_MIcombine( with( timss_design , svyby( ~ countries_thru_canada , ~ sex , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: timss_MIcombine( with( timss_design , svytotal( ~ asmmat , na.rm = TRUE ) ) ) timss_MIcombine( with( timss_design , svyby( ~ asmmat , ~ sex , svytotal , na.rm = TRUE ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: timss_MIcombine( with( timss_design , svytotal( ~ countries_thru_canada ) ) ) timss_MIcombine( with( timss_design , svyby( ~ countries_thru_canada , ~ sex , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: timss_MIcombine( with( timss_design , svyquantile( ~ asmmat , 0.5 , se = TRUE , na.rm = TRUE ) ) ) timss_MIcombine( with( timss_design , svyby( ~ asmmat , ~ sex , svyquantile , 0.5 , se = TRUE , ci = TRUE , na.rm = TRUE ) ) ) Estimate a ratio: timss_MIcombine( with( timss_design , svyratio( numerator = ~ asssci , denominator = ~ asmmat ) ) ) Subsetting Restrict the survey design to Australia, Austria, Azerbaijan, Belgium (French): sub_timss_design <- subset( timss_design , idcntry %in% c( 36 , 40 , 31 , 956 ) ) Calculate the mean (average) of this subset: timss_MIcombine( with( sub_timss_design , svymean( ~ asmmat , na.rm = TRUE ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- timss_MIcombine( with( timss_design , svymean( ~ asmmat , na.rm = TRUE ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- timss_MIcombine( with( timss_design , svyby( ~ asmmat , ~ sex , svymean , na.rm = TRUE ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( timss_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: timss_MIcombine( with( timss_design , svyvar( ~ asmmat , na.rm = TRUE ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement timss_MIcombine( with( timss_design , svymean( ~ asmmat , na.rm = TRUE , deff = TRUE ) ) ) # SRS with replacement timss_MIcombine( with( timss_design , svymean( ~ asmmat , na.rm = TRUE , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ born_in_country , timss_design , # method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( asmmat ~ born_in_country , timss_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ born_in_country + countries_thru_canada , timss_design ) Perform a survey-weighted generalized linear model: glm_result <- timss_MIcombine( with( timss_design , svyglm( asmmat ~ born_in_country + countries_thru_canada ) ) ) summary( glm_result ) Replication Example This example matches the mean proficiency and standard error of the Australia row of the Summary Statistics and Standard Errors for Proficiency in Overall Mathematics-Grade 4 table from the Appendix 14A: Summary Statistics and Standard Errors for Proficiency in Grade 4 Mathematics: australia_design <- subset( timss_design , countries_thru_canada %in% "Australia" ) stopifnot( nrow( australia_design ) == 5890 ) result <- timss_MIcombine( with( australia_design , svymean( ~ asmmat ) ) ) stopifnot( round( coef( result ) , 3 ) == 515.880 ) stopifnot( round( SE( result ) , 3 ) == 2.776 ) This example matches the jackknife sampling, imputation, and total variances of the same row: australia_fn <- unzipped_files[ grepl( 'asgaus' , basename( unzipped_files ) ) ] australia_tbl <- read_spss( australia_fn ) australia_tbl <- zap_labels( australia_tbl ) australia_df <- data.frame( australia_tbl ) names( australia_df ) <- tolower( names( australia_df ) ) estimate <- mean( c( with( australia_df , weighted.mean( asmmat01 , totwgt ) ) , with( australia_df , weighted.mean( asmmat02 , totwgt ) ) , with( australia_df , weighted.mean( asmmat03 , totwgt ) ) , with( australia_df , weighted.mean( asmmat04 , totwgt ) ) , with( australia_df , weighted.mean( asmmat05 , totwgt ) ) ) ) stopifnot( round( estimate , 3 ) == 515.880 ) for( k in 1:5 ){ this_variance <- 0 for( j in 1:75 ){ for( i in 0:1 ){ this_variance <- this_variance + ( weighted.mean( australia_df[ , paste0( 'asmmat0' , k ) ] , ifelse( j == australia_df[ , 'jkzone' ] , australia_df[ , 'totwgt' ] * 2 * ( australia_df[ , 'jkrep' ] == i ) , australia_df[ , 'totwgt' ] ) ) - weighted.mean( australia_df[ , paste0( 'asmmat0' , k ) ] , australia_df[ , 'totwgt' ] ) )^2 } } assign( paste0( 'v' , k ) , this_variance * 0.5 ) } sampling_variance <- mean( c( v1 , v2 , v3 , v4 , v5 ) ) stopifnot( round( sampling_variance , 3 ) == 7.397 ) imputation_variance <- ( 6 / 5 ) * ( ( ( with( australia_df , weighted.mean( asmmat01 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asmmat02 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asmmat03 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asmmat04 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asmmat05 , totwgt ) ) - estimate )^2 / 4 ) ) stopifnot( round( imputation_variance , 3 ) == 0.309 ) stopifnot( round( sampling_variance + imputation_variance , 3 ) == 7.706 ) "],["youth-risk-behavior-surveillance-system-yrbss.html", "Youth Risk Behavior Surveillance System (YRBSS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Youth Risk Behavior Surveillance System (YRBSS) The high school edition of the Behavioral Risk Factor Surveillance System (BRFSS). One table with one row per sampled youth respondent. A complex sample survey designed to generalize to all public and private school students in grades 9-12 in the United States. Released biennially since 1993. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: Methodology of the Youth Risk Behavior Surveillance System Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # maladolescence # epidemiology # sex, drugs, rock and roll Download, Import, Preparation Load the SAScii library to interpret a SAS input program, and also re-arrange the SAS input program: library(SAScii) sas_url <- "https://www.cdc.gov/healthyyouth/data/yrbs/files/2019/2019XXH-SAS-Input-Program.sas" sas_text <- tolower( readLines( sas_url ) ) # find the (out of numerical order) # `site` location variable's position # within the SAS input program site_location <- which( sas_text == '@1 site $3.' ) # find the start field's position # within the SAS input program input_location <- which( sas_text == "input" ) # create a vector from 1 to the length of the text file sas_length <- seq( length( sas_text ) ) # remove the site_location sas_length <- sas_length[ -site_location ] # re-insert the site variable's location # immediately after the starting position sas_reorder <- c( sas_length[ seq( input_location ) ] , site_location , sas_length[ seq( input_location + 1 , length( sas_length ) ) ] ) # re-order the sas text file sas_text <- sas_text[ sas_reorder ] sas_tf <- tempfile() writeLines( sas_text , sas_tf ) Download and import the national file: dat_tf <- tempfile() dat_url <- "https://www.cdc.gov/healthyyouth/data/yrbs/files/2019/XXH2019_YRBS_Data.dat" download.file( dat_url , dat_tf , mode = 'wb' ) yrbss_df <- read.SAScii( dat_tf , sas_tf ) names( yrbss_df ) <- tolower( names( yrbss_df ) ) yrbss_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # yrbss_fn <- file.path( path.expand( "~" ) , "YRBSS" , "this_file.rds" ) # saveRDS( yrbss_df , file = yrbss_fn , compress = FALSE ) Load the same object: # yrbss_df <- readRDS( yrbss_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) yrbss_design <- svydesign( ~ psu , strata = ~ stratum , data = yrbss_df , weights = ~ weight , nest = TRUE ) Variable Recoding Add new columns to the data set: yrbss_design <- update( yrbss_design , q2 = q2 , never_rarely_wore_seat_belt = as.numeric( qn8 == 1 ) , ever_used_marijuana = as.numeric( qn45 == 1 ) , tried_to_quit_tobacco_past_year = as.numeric( q39 == 2 ) , used_tobacco_past_year = as.numeric( q39 > 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( yrbss_design , "sampling" ) != 0 ) svyby( ~ one , ~ ever_used_marijuana , yrbss_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , yrbss_design ) svyby( ~ one , ~ ever_used_marijuana , yrbss_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ bmipct , yrbss_design , na.rm = TRUE ) svyby( ~ bmipct , ~ ever_used_marijuana , yrbss_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ q2 , yrbss_design , na.rm = TRUE ) svyby( ~ q2 , ~ ever_used_marijuana , yrbss_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ bmipct , yrbss_design , na.rm = TRUE ) svyby( ~ bmipct , ~ ever_used_marijuana , yrbss_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ q2 , yrbss_design , na.rm = TRUE ) svyby( ~ q2 , ~ ever_used_marijuana , yrbss_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ bmipct , yrbss_design , 0.5 , na.rm = TRUE ) svyby( ~ bmipct , ~ ever_used_marijuana , yrbss_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ tried_to_quit_tobacco_past_year , denominator = ~ used_tobacco_past_year , yrbss_design , na.rm = TRUE ) Subsetting Restrict the survey design to youths who ever drank alcohol: sub_yrbss_design <- subset( yrbss_design , qn40 > 1 ) Calculate the mean (average) of this subset: svymean( ~ bmipct , sub_yrbss_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ bmipct , yrbss_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ bmipct , ~ ever_used_marijuana , yrbss_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( yrbss_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ bmipct , yrbss_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ bmipct , yrbss_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ bmipct , yrbss_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ never_rarely_wore_seat_belt , yrbss_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( bmipct ~ never_rarely_wore_seat_belt , yrbss_design ) Perform a chi-squared test of association for survey data: svychisq( ~ never_rarely_wore_seat_belt + q2 , yrbss_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( bmipct ~ never_rarely_wore_seat_belt + q2 , yrbss_design ) summary( glm_result ) Replication Example This example matches statistics, standard errors, and confidence intervals from the “never/rarely wore seat belt” row of PDF page 29 of this CDC analysis software document: unwtd_count_result <- unwtd.count( ~ never_rarely_wore_seat_belt , yrbss_design ) stopifnot( coef( unwtd_count_result ) == 11149 ) wtd_n_result <- svytotal( ~ one , subset( yrbss_design , !is.na( never_rarely_wore_seat_belt ) ) ) stopifnot( round( coef( wtd_n_result ) , 0 ) == 12132 ) share_result <- svymean( ~ never_rarely_wore_seat_belt , yrbss_design , na.rm = TRUE ) stopifnot( round( coef( share_result ) , 4 ) == .0654 ) stopifnot( round( SE( share_result ) , 4 ) == .0065 ) ci_result <- svyciprop( ~ never_rarely_wore_seat_belt , yrbss_design , na.rm = TRUE , method = "beta" ) stopifnot( round( confint( ci_result )[1] , 4 ) == 0.0529 ) stopifnot( round( confint( ci_result )[2] , 2 ) == 0.08 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for YRBSS users, this code replicates previously-presented examples: library(srvyr) yrbss_srvyr_design <- as_survey( yrbss_design ) Calculate the mean (average) of a linear variable, overall and by groups: yrbss_srvyr_design %>% summarize( mean = survey_mean( bmipct , na.rm = TRUE ) ) yrbss_srvyr_design %>% group_by( ever_used_marijuana ) %>% summarize( mean = survey_mean( bmipct , na.rm = TRUE ) ) "],["404.html", "Page not found", " Page not found The page you requested cannot be found (perhaps it was moved or renamed). You may want to try searching to find the page's new location, or use the table of contents to find the page you are looking for. "]] +[["index.html", "Analyze Survey Data for Free Forty-One Public Microdatasets To Analyze Before You Die From An Easy To Type Website", " Analyze Survey Data for Free Forty-One Public Microdatasets To Analyze Before You Die From An Easy To Type Website Please ask questions about this book at stackoverflow.com with the R and survey tags. This book replaces my archived blog, prior code, and the no longer maintained lodown package. A work of R is never finished, merely abandoned. - Anthony Damico "],["trend-analysis-of-complex-survey-data.html", "Trend Analysis of Complex Survey Data Download, Import, Preparation Append Polynomials to Each Year Unadjusted Analysis Examples Calculate Joinpoints Needed Calculate Predicted Marginals Identify Joinpoint(s) or Breakpoint(s) Interpret and Conclude", " Trend Analysis of Complex Survey Data The purpose of this analysis is to make statistically valid statements such as, “there was a significant linear decrease in the prevalence of high school aged americans who have ever smoked a cigarette across the period 1999-2011” with complex sample survey data. This step-by-step walkthrough exactly reproduces the statistics presented in the Center for Disease Control & Prevention’s (CDC) linear trend analysis. This analysis may complement qualitative evaluation on prevalence changes observed from surveillance data by providing quantitative evidence, such as when a joinpoint (also called breakpoint or changepoint) occurred; however, this analysis does not explain why or how changes in trends occur. Download, Import, Preparation Download and import the multi-year stacked file: library(SAScii) library(readr) sas_url <- "https://www.cdc.gov/healthyyouth/data/yrbs/sadc_2019/2019-SADC-SAS-Input-Program.sas" dat_url <- "https://www.cdc.gov/healthyyouth/data/yrbs/sadc_2019/sadc_2019_national.dat" sas_positions <- parse.SAScii( sas_url ) sas_positions[ , 'varname' ] <- tolower( sas_positions[ , 'varname' ] ) variables_to_keep <- c( "sex" , "grade" , "race4" , "q30" , "year" , "psu" , "stratum" , "weight" ) sas_positions[ , 'column_types' ] <- ifelse( !( sas_positions[ , 'varname' ] %in% variables_to_keep ) , "_" , ifelse( sas_positions[ , 'char' ] , "c" , "d" ) ) yrbss_tbl <- read_fwf( dat_url , fwf_widths( abs( sas_positions[ , 'width' ] ) , col_names = sas_positions[ , 'varname' ] ) , col_types = paste0( sas_positions[ , 'column_types' ] , collapse = "" ) , na = c( "" , "." ) ) yrbss_df <- data.frame( yrbss_tbl ) Restrict the dataset to only years shown in the original analysis and re-name the main variable: yrbss_df <- subset( yrbss_df , year %in% seq( 1991 , 2011 , 2 ) ) yrbss_df[ , 'ever_smoked' ] <- as.numeric( yrbss_df[ , 'q30' ] == 1 ) yrbss_df[ , 'q30' ] <- NULL Recode each categorical variable to factor class: yrbss_df[ , 'sex' ] <- relevel( factor( yrbss_df[ , 'sex' ] ) , ref = "2" ) for ( i in c( 'race4' , 'grade' ) ){ yrbss_df[ , i ] <- relevel( factor( yrbss_df[ , i ] ) , ref = "1" ) } Append Polynomials to Each Year “The polynomials we have used as predictors to this point are natural polynomials, generated from the linear predictor by centering and then powering the linear predictor.” For more detail on this subject, see page 216 of Applied Multiple Regression/Correlation Analysis for the Behavioral Sciences By Jacob Cohen, Patricia Cohen, Stephen G. West, Leona S. Aiken distinct_years_available <- length( seq( 1991 , 2011 , 2 ) ) # store the linear polynomials c11l <- contr.poly( distinct_years_available )[ , ".L" ] # store the quadratic polynomials c11q <- contr.poly( distinct_years_available )[ , ".Q" ] # store the cubic polynomials c11c <- contr.poly( distinct_years_available )[ , ".C" ] For each record in the data set, tack on the linear, quadratic, and cubic contrast value, these contrast values will serve as replacement for the linear year variable in any regression: # year^1 term (linear) yrbss_df[ , "t11l" ] <- c11l[ match( yrbss_df[ , "year" ] , seq( 1991 , 2011 , 2 ) ) ] # year^2 term (quadratic) yrbss_df[ , "t11q" ] <- c11q[ match( yrbss_df[ , "year" ] , seq( 1991 , 2011 , 2 ) ) ] # year^3 term (cubic) yrbss_df[ , "t11c" ] <- c11c[ match( yrbss_df[ , "year" ] , seq( 1991 , 2011 , 2 ) ) ] Unadjusted Analysis Examples Construct a complex sample survey design and match the published unadjusted prevalence rates: options( survey.lonely.psu = "adjust" ) library(survey) des <- svydesign( id = ~psu , strata = ~interaction( stratum , year ) , data = yrbss_df , weights = ~weight , nest = TRUE ) prevalence_over_time <- svyby( ~ ever_smoked , ~ year , des , svymean , na.rm = TRUE ) # confirm prevalence rates match published estimates # of high school students that ever smoked stopifnot( all.equal( round( coef( prevalence_over_time ) , 3 ) , c( .701 , .695 , .713 , .702 , .704 , .639 , .584 , .543 , .503 , .463 , .447 ) , check.attributes = FALSE ) ) Calculate Joinpoints Needed Using the orthogonal coefficients (linear, quadratic, cubic terms) that we previously added to our yrbss_df object before constructing the multi-year stacked survey design, determine how many joinpoints will be needed for a trend analysis. Epidemiological models typically control for possible confounding variables such as age, sex, and race/ethnicity, so those have been included alongside the linear, cubic, and quadratic year terms. Calculate the “ever smoked” regression, adjusted by sex, grade, race/ethnicity, and linear year contrast: linyear <- svyglm( ever_smoked ~ sex + race4 + grade + t11l , design = des , family = quasibinomial ) summary( linyear ) The linear year-contrast variable t11l is significant. Therefore, there is probably going to be some sort of trend. A linear trend by itself does not need joinpoints. Not one, just zero joinpoints. If the linear term were the only significant term (out of linear, quadratic, cubic), then we would not need to calculate a joinpoint. In other words, we would not need to figure out where to best break our time trend into two, three, or even four segments. Since the linear trend is significant, we know there is at least one change across the entire 1991 to 2011 period. Interpretation note about segments of time: The linear term t11l was significant, so we probably have a significant linear trend somewhere to report. Now we need to figure out when that significant linear trend started and when it ended. It might be semantically true that there was a significant linear decrease in high school aged smoking over the entire period of our data 1991-2011; however, it’s inexact to end this analysis after only detecting a linear trend. The purpose of the following few steps is to cordon off different time points from one another. As you’ll see later, there actually was not any detectable decrease from 1991-1999. The entirety of the decline in smoking occurred over the period from 1999-2011. So these next (methodologically tricky) steps serve to provide you and your audience with a more careful statement of statistical significance. It’s not technically wrong to conclude that smoking declined over the period of 1991-2011, it’s just verbose. Think of it as the difference between “humans first walked on the moon in the sixties” and “humans first walked on the moon in 1969” - both statements are correct, but the latter exhibits greater scientific precision. Calculate the “ever smoked” binomial regression, adjusted by sex, grade, race/ethnicity, and both linear and quadratic year contrasts. Notice the addition of t11q: quadyear <- svyglm( ever_smoked ~ sex + race4 + grade + t11l + t11q , design = des , family = quasibinomial ) summary( quadyear ) The linear year-contrast variable is significant but the quadratic year-contrast variable is also significant. Therefore, we should use joinpoint software (the segmented package) for this analysis. A significant quadratic trend needs one joinpoint. Since both linear and quadratic terms are significant, we can also move ahead and test whether the cubic term is also significant. Calculate the “ever smoked” binomial regression, adjusted by sex, grade, race/ethnicity, and linear, quadratic, and cubic year contrasts. Notice the addition of t11c: cubyear <- svyglm( ever_smoked ~ sex + race4 + grade + t11l + t11q + t11c , design = des , family = quasibinomial ) summary( cubyear ) The cubic year-contrast term is also significant in this model. Therefore, we might potentially evaluate this trend using two joinpoints. In other words, a significant result for all linear, quadratic, and cubic year contrasts at this point means we might be able to evaluate three distinct trends (separated by our two joinpoints) across the broader 1991 - 2011 time period of analysis. Although we might now have the statistical ability to analyze three distinct time periods (separated by two joinpoints) across our data, the utility of this depends on the circumstances. Cubic and higher polynomials account for not only the direction of change but also the pace of that change, allowing statistical statements that might not be of interest to an audience: While it might be an exercise in precision to conclude that smoking rates dropped quickest across 1999-2003 and less quickly across 2003-2011, that scientific pair of findings may not be as compelling as the simpler (quadratic but not cubic) statement that smoking rates have dropped across the period of 1999-2011. Calculate Predicted Marginals Calculate the survey-year-independent predictor effects and store these results: marginals <- svyglm( formula = ever_smoked ~ sex + race4 + grade , design = des , family = quasibinomial ) Run these marginals through the svypredmeans function. For archaeology fans out there, this function emulates the PREDMARG statement in the ancient language of SUDAAN: ( means_for_joinpoint <- svypredmeans( marginals , ~factor( year ) ) ) Clean up these results a bit in preparation for a joinpoint analysis: # coerce the results to a data.frame object means_for_joinpoint <- as.data.frame( means_for_joinpoint ) # extract the row names as the survey year means_for_joinpoint[ , "year" ] <- as.numeric( rownames( means_for_joinpoint ) ) # must be sorted, just in case it's not already means_for_joinpoint <- means_for_joinpoint[ order( means_for_joinpoint[ , "year" ] ) , ] Identify Joinpoint(s) or Breakpoint(s) Let’s take a look at how confident we are in the value at each adjusted timepoint. Carrying out a trend analysis requires creating new weights to fit a piecewise linear regression. First, create that weight variable: means_for_joinpoint[ , "wgt" ] <- with( means_for_joinpoint, ( mean / SE ) ^ 2 ) Second, fit a piecewise linear regression, estimating the ‘starting’ linear model with the usual lm function using the log values and the weights: o <- lm( log( mean ) ~ year , weights = wgt , data = means_for_joinpoint ) Now that the regression has been structured correctly, estimate the year that our complex survey trend should be broken into two or more segments: library(segmented) # find only one joinpoint os <- segmented( o , ~year ) summary( os ) Look for the Estimated Break-Point(s) in that result - that’s the critical number from this joinpoint analysis. The segmented package uses an iterative procedure (described in the article below); between-year solutions are returned and should be rounded to the nearest time point in the analysis. The joinpoint software implements two estimating algorithms: the grid-search and the Hudson algorithm. For more detail about these methods, see Muggeo V. (2003) Estimating regression models with unknown break-points. Statistics in Medicine, 22: 3055-3071.. Obtain the annual percent change estimates for each time point: slope( os , APC = TRUE ) The confidence intervals for the annual percent change (APC) may be different from the ones returned by NCI’s Joinpoint Software; for further details, check out Muggeo V. (2010) A Comment on `Estimating average annual per cent change in trend analysis’ by Clegg et al., Statistics in Medicine; 28, 3670-3682. Statistics in Medicine, 29, 1958-1960. This analysis returned similar results to the NCI’s Joinpoint Regression Program by estimating a joinpoint at year=1999 - and, more precisely, that the start of that decreasing trend in smoking prevalence happened at an APC of -3.92 percent. That is, slope2 from the output above. Remember that the cubic-year model above had significant terms as well. Therefore, it would be statistically defensible to calculate two joinpoints rather than only one. However, for this analyses, breaking the 1999-2011 trend into two separate downward trends might not be of interest to the audience. Looking at the slope2 and slope3 estimates and confidence intervals, we might be able to conclude that “ever smoking” decreased across 1999-2003 and also decreased (albeit less rapidly) across 2003-2011. However, communicating two consecutive downward trends might not be of much interest to a lay audience. Forgoing a second possible joinpoint makes sense when the direction of change is more compelling than the pace of change: # find two joinpoints rather than only one os2 <- segmented( o , ~year , npsi = 2 ) summary( os2 ) slope( os2 , APC = TRUE ) Interpret and Conclude After identifying the joinpoint for smoking prevalence, we can create two regression models (one for each time segment - if we had two joinpoints, we would need three regression models). The first model covers the years leading up to (and including) the joinpoint (i.e., 1991 to 1999). The second model includes the years from the joinpoint forward (i.e., 1999 to 2011). So start with 1991, 1993, 1995, 1997, 1999, the five year-points before (and including) 1999: # calculate a five-timepoint linear contrast vector c5l <- contr.poly( 5 )[ , 1 ] # tack the five-timepoint linear contrast vectors onto the current survey design object des <- update( des , t5l = c5l[ match( year , seq( 1991 , 1999 , 2 ) ) ] ) pre_91_99 <- svyglm( ever_smoked ~ sex + race4 + grade + t5l , design = subset( des , year <= 1999 ) , family = quasibinomial ) summary( pre_91_99 ) # confirm 1991-1999 trend coefficient matches published estimates stopifnot( round( pre_91_99$coefficients['t5l'] , 5 ) == .03704 ) This reproduces the calculations behind the sentence on pdf page 6 of the original document: In this example, T5L_L had a p-value=0.52261 and beta=0.03704. Therefore, there was “no significant change in the prevalence of ever smoking a cigarette during 1991-1999.” Then move on to 1999, 2001, 2003, 2005, 2007, 2009, and 2011, the seven year-points after (and including) 1999: # calculate a seven-timepoint linear contrast vector c7l <- contr.poly( 7 )[ , 1 ] # tack the seven-timepoint linear contrast vectors onto the current survey design object des <- update( des , t7l = c7l[ match( year , seq( 1999 , 2011 , 2 ) ) ] ) post_99_11 <- svyglm( ever_smoked ~ sex + race4 + grade + t7l , design = subset( des , year >= 1999 ) , family = quasibinomial ) summary( post_99_11 ) # confirm 1999-2011 trend coefficient matches published estimates stopifnot( round( post_99_11$coefficients['t7l'] , 5 ) == -0.99165 ) This reproduces the calculations behind the sentence on pdf page 6 of the original document: In this example, T7L_R had a p-value<0.0001 and beta=-0.99165. Therefore, there was a “significant linear decrease in the prevalence of ever smoking a cigarette during 1999-2011.” "],["american-community-survey-acs.html", "American Community Survey (ACS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " American Community Survey (ACS) The US Census Bureau’s annual replacement for the long-form decennial census. Two tables per state, the first with one row per household and the second with one row per individual. The civilian population of the United States. Released annually since 2005. Administered and financed by the US Census Bureau. Please skim before you begin: Guidance for Data Users Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # one percent sample # the decennial census # in miniature Download, Import, Preparation Download and import the Alabama household file: (switch sas_hal to sas_hak for Alaska or sas_hus for the entire country) library(haven) tf_household <- tempfile() this_url_household <- "https://www2.census.gov/programs-surveys/acs/data/pums/2021/1-Year/sas_hal.zip" download.file( this_url_household , tf_household , mode = 'wb' ) unzipped_files_household <- unzip( tf_household , exdir = tempdir() ) acs_sas_household <- grep( '\\\\.sas7bdat$' , unzipped_files_household , value = TRUE ) acs_df_household <- read_sas( acs_sas_household ) names( acs_df_household ) <- tolower( names( acs_df_household ) ) Download and import the Alabama person file: (switch sas_pal to sas_pak for Alaska or sas_pus for the entire country) tf_person <- tempfile() this_url_person <- "https://www2.census.gov/programs-surveys/acs/data/pums/2021/1-Year/sas_pal.zip" download.file( this_url_person , tf_person , mode = 'wb' ) unzipped_files_person <- unzip( tf_person , exdir = tempdir() ) acs_sas_person <- grep( '\\\\.sas7bdat$' , unzipped_files_person , value = TRUE ) acs_df_person <- read_sas( acs_sas_person ) names( acs_df_person ) <- tolower( names( acs_df_person ) ) Remove overlapping column and merge household + person files: acs_df_household[ , 'rt' ] <- NULL acs_df_person[ , 'rt' ] <- NULL acs_df <- merge( acs_df_household , acs_df_person ) stopifnot( nrow( acs_df ) == nrow( acs_df_person ) ) acs_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # acs_fn <- file.path( path.expand( "~" ) , "ACS" , "this_file.rds" ) # saveRDS( acs_df , file = acs_fn , compress = FALSE ) Load the same object: # acs_df <- readRDS( acs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) acs_design <- svrepdesign( weight = ~pwgtp , repweights = 'pwgtp[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = acs_df ) Variable Recoding Add new columns to the data set: acs_design <- update( acs_design , state_name = factor( as.numeric( st ) , levels = c(1L, 2L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 12L, 13L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 53L, 54L, 55L, 56L, 72L) , labels = c("Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "District of Columbia", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming", "Puerto Rico") ) , cit = factor( cit , levels = 1:5 , labels = c( 'born in the u.s.' , 'born in the territories' , 'born abroad to american parents' , 'naturalized citizen' , 'non-citizen' ) ) , poverty_level = as.numeric( povpip ) , married = as.numeric( mar %in% 1 ) , sex = factor( sex , labels = c( 'male' , 'female' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( acs_design , "sampling" ) != 0 ) svyby( ~ one , ~ cit , acs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , acs_design ) svyby( ~ one , ~ cit , acs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ poverty_level , acs_design , na.rm = TRUE ) svyby( ~ poverty_level , ~ cit , acs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ sex , acs_design ) svyby( ~ sex , ~ cit , acs_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ poverty_level , acs_design , na.rm = TRUE ) svyby( ~ poverty_level , ~ cit , acs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ sex , acs_design ) svyby( ~ sex , ~ cit , acs_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ poverty_level , acs_design , 0.5 , na.rm = TRUE ) svyby( ~ poverty_level , ~ cit , acs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ ssip , denominator = ~ pincp , acs_design , na.rm = TRUE ) Subsetting Restrict the survey design to senior citizens: sub_acs_design <- subset( acs_design , agep >= 65 ) Calculate the mean (average) of this subset: svymean( ~ poverty_level , sub_acs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ poverty_level , acs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ poverty_level , ~ cit , acs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( acs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ poverty_level , acs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ poverty_level , acs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ poverty_level , acs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ married , acs_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( poverty_level ~ married , acs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ married + sex , acs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( poverty_level ~ married + sex , acs_design ) summary( glm_result ) Replication Example This example matches statistics, standard errors, and margin of errors from the 2021 PUMS tallies: Match the sum of the weights: stopifnot( round( coef( svytotal( ~ one , acs_design ) ) , 0 ) == 5039877 ) Compute the population by age: pums_estimate <- c(288139L, 299245L, 336727L, 334606L, 327102L, 635004L, 641405L, 615709L, 335431L, 341926L, 538367L, 265742L, 80474L) pums_standard_error <- c(2727L, 5368L, 6067L, 4082L, 4485L, 5716L, 4420L, 3706L, 4836L, 5100L, 2158L, 3363L, 3186L) pums_margin_of_error <- c(4486L, 8830L, 9981L, 6715L, 7378L, 9402L, 7271L, 6096L, 7956L, 8389L, 3550L, 5532L, 5240L) results <- svytotal( ~ as.numeric( agep %in% 0:4 ) + as.numeric( agep %in% 5:9 ) + as.numeric( agep %in% 10:14 ) + as.numeric( agep %in% 15:19 ) + as.numeric( agep %in% 20:24 ) + as.numeric( agep %in% 25:34 ) + as.numeric( agep %in% 35:44 ) + as.numeric( agep %in% 45:54 ) + as.numeric( agep %in% 55:59 ) + as.numeric( agep %in% 60:64 ) + as.numeric( agep %in% 65:74 ) + as.numeric( agep %in% 75:84 ) + as.numeric( agep %in% 85:100 ) , acs_design ) stopifnot( all( round( coef( results ) , 0 ) == pums_estimate ) ) stopifnot( all( round( SE( results ) , 0 ) == pums_standard_error ) ) stopifnot( all( round( SE( results ) * 1.645 , 0 ) == pums_margin_of_error ) ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for ACS users, this code calculates the gini coefficient on complex sample survey data: library(convey) acs_design <- convey_prep( acs_design ) svygini( ~ hincp , acs_design , na.rm = TRUE ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for ACS users, this code replicates previously-presented examples: library(srvyr) acs_srvyr_design <- as_survey( acs_design ) Calculate the mean (average) of a linear variable, overall and by groups: acs_srvyr_design %>% summarize( mean = survey_mean( poverty_level , na.rm = TRUE ) ) acs_srvyr_design %>% group_by( cit ) %>% summarize( mean = survey_mean( poverty_level , na.rm = TRUE ) ) "],["area-health-resources-files-ahrf.html", "Area Health Resources Files (AHRF) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Area Health Resources Files (AHRF) National, state, and county-level data on health care professions, health facilities, population characteristics, health workforce training, hospital utilization and expenditure, and the environment. One table with one row per county and a second table with one row per state. Replaced annually with the latest available county- and state-level statistics. Compiled by the Bureau of Health Workforce at the Health Services and Resources Administration. Please skim before you begin: User Documentation for the County Area Health Resources File (AHRF) 2021-2022 Release Frequently Asked Questions This human-composed haiku or a bouquet of artificial intelligence-generated limericks # local aggregates # to spread merge join spline regress # like fresh buttered bread Download, Import, Preparation Download and import the most current county-level file: library(haven) tf <- tempfile() ahrf_url <- "https://data.hrsa.gov//DataDownload/AHRF/AHRF_2021-2022_SAS.zip" download.file( ahrf_url , tf , mode = 'wb' ) unzipped_files <- unzip( tf , exdir = tempdir() ) sas_fn <- grep( "\\\\.sas7bdat$" , unzipped_files , value = TRUE ) ahrf_tbl <- read_sas( sas_fn ) ahrf_df <- data.frame( ahrf_tbl ) names( ahrf_df ) <- tolower( names( ahrf_df ) ) Save locally   Save the object at any point: # ahrf_fn <- file.path( path.expand( "~" ) , "AHRF" , "this_file.rds" ) # saveRDS( ahrf_df , file = ahrf_fn , compress = FALSE ) Load the same object: # ahrf_df <- readRDS( ahrf_fn ) Variable Recoding Add new columns to the data set: ahrf_df <- transform( ahrf_df , cbsa_indicator_code = factor( as.numeric( f1406720 ) , levels = 0:2 , labels = c( "not metro" , "metro" , "micro" ) ) , mhi_2020 = f1322620 , whole_county_hpsa_2022 = as.numeric( f0978722 ) == 1 , census_region = factor( as.numeric( f04439 ) , levels = 1:4 , labels = c( "northeast" , "midwest" , "south" , "west" ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( ahrf_df ) table( ahrf_df[ , "cbsa_indicator_code" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( ahrf_df[ , "mhi_2020" ] , na.rm = TRUE ) tapply( ahrf_df[ , "mhi_2020" ] , ahrf_df[ , "cbsa_indicator_code" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( ahrf_df[ , "census_region" ] ) ) prop.table( table( ahrf_df[ , c( "census_region" , "cbsa_indicator_code" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( ahrf_df[ , "mhi_2020" ] , na.rm = TRUE ) tapply( ahrf_df[ , "mhi_2020" ] , ahrf_df[ , "cbsa_indicator_code" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( ahrf_df[ , "mhi_2020" ] , 0.5 , na.rm = TRUE ) tapply( ahrf_df[ , "mhi_2020" ] , ahrf_df[ , "cbsa_indicator_code" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to California: sub_ahrf_df <- subset( ahrf_df , f12424 == "CA" ) Calculate the mean (average) of this subset: mean( sub_ahrf_df[ , "mhi_2020" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( ahrf_df[ , "mhi_2020" ] , na.rm = TRUE ) tapply( ahrf_df[ , "mhi_2020" ] , ahrf_df[ , "cbsa_indicator_code" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( mhi_2020 ~ whole_county_hpsa_2022 , ahrf_df ) Perform a chi-squared test of association: this_table <- table( ahrf_df[ , c( "whole_county_hpsa_2022" , "census_region" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( mhi_2020 ~ whole_county_hpsa_2022 + census_region , data = ahrf_df ) summary( glm_result ) Replication Example Match the record count in row number 8,543 of AHRF 2021-2022 Technical Documentation.xlsx: stopifnot( nrow( ahrf_df ) == 3232 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for AHRF users, this code replicates previously-presented examples: library(dplyr) ahrf_tbl <- as_tibble( ahrf_df ) Calculate the mean (average) of a linear variable, overall and by groups: ahrf_tbl %>% summarize( mean = mean( mhi_2020 , na.rm = TRUE ) ) ahrf_tbl %>% group_by( cbsa_indicator_code ) %>% summarize( mean = mean( mhi_2020 , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for AHRF users, this code replicates previously-presented examples: library(data.table) ahrf_dt <- data.table( ahrf_df ) Calculate the mean (average) of a linear variable, overall and by groups: ahrf_dt[ , mean( mhi_2020 , na.rm = TRUE ) ] ahrf_dt[ , mean( mhi_2020 , na.rm = TRUE ) , by = cbsa_indicator_code ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for AHRF users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'ahrf' , ahrf_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( mhi_2020 ) FROM ahrf' ) dbGetQuery( con , 'SELECT cbsa_indicator_code , AVG( mhi_2020 ) FROM ahrf GROUP BY cbsa_indicator_code' ) "],["american-housing-survey-ahs.html", "American Housing Survey (AHS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " American Housing Survey (AHS) The nationwide assessment of housing stock, with information on physical condition and neighborhood, costs of financing and maintenance, owner and renter characteristics, and changes over time. Nationally-representative and metropolitan flat files with one row per household, plus relational files. A complex sample survey of occupied and vacant housing units designed to generalize to all structures in the United States, both nationally and also for about thirty-five metropolitan areas. Released more or less biennially since 1973, with longitudinal samples redrawn in 1985 and 2015. Sponsored by the Department of Housing and Urban Development, run by the Census Bureau. Please skim before you begin: Getting Started with the Public Use File: 2015 and Beyond Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # real estate supply # half bath addition, raised roof # vent, rent too damn high Download, Import, Preparation Download and import the national 2021 flat file: library(haven) library(httr) tf <- tempfile() this_url <- paste0( "https://www2.census.gov/programs-surveys/ahs/" , "2021/AHS%202021%20National%20PUF%20v1.0%20Flat%20SAS.zip" ) GET( this_url , write_disk( tf ) , progress() ) ahs_tbl <- read_sas( tf ) ahs_df <- data.frame( ahs_tbl ) names( ahs_df ) <- tolower( names( ahs_df ) ) Save locally   Save the object at any point: # ahs_fn <- file.path( path.expand( "~" ) , "AHS" , "this_file.rds" ) # saveRDS( ahs_df , file = ahs_fn , compress = FALSE ) Load the same object: # ahs_df <- readRDS( ahs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) ahs_design <- svrepdesign( weights = ~ weight , repweights = "repweight[1-9]" , type = "Fay" , rho = ( 1 - 1 / sqrt( 4 ) ) , mse = TRUE , data = ahs_df ) Variable Recoding Add new columns to the data set: ahs_design <- update( ahs_design , one = 1 , tenure = factor( ifelse( tenure %in% c( -6 , 'N' ) , 4 , tenure ) , levels = 1:4 , labels = c( 'Owned or being bought' , 'Rented for cash rent' , 'Occupied without payment of cash rent' , 'Not occupied' ) ) , lotsize = factor( lotsize , levels = 1:7 , labels = c( "Less then 1/8 acre" , "1/8 up to 1/4 acre" , "1/4 up to 1/2 acre" , "1/2 up to 1 acre" , "1 up to 5 acres" , "5 up to 10 acres" , "10 acres or more" ) ) , below_poverty = as.numeric( perpovlvl < 100 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( ahs_design , "sampling" ) != 0 ) svyby( ~ one , ~ tenure , ahs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , ahs_design ) svyby( ~ one , ~ tenure , ahs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ totrooms , ahs_design , na.rm = TRUE ) svyby( ~ totrooms , ~ tenure , ahs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ lotsize , ahs_design , na.rm = TRUE ) svyby( ~ lotsize , ~ tenure , ahs_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ totrooms , ahs_design , na.rm = TRUE ) svyby( ~ totrooms , ~ tenure , ahs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ lotsize , ahs_design , na.rm = TRUE ) svyby( ~ lotsize , ~ tenure , ahs_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ totrooms , ahs_design , 0.5 , na.rm = TRUE ) svyby( ~ totrooms , ~ tenure , ahs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ totrooms , denominator = ~ rent , ahs_design , na.rm = TRUE ) Subsetting Restrict the survey design to homes with a garage or carport: sub_ahs_design <- subset( ahs_design , garage == 1 ) Calculate the mean (average) of this subset: svymean( ~ totrooms , sub_ahs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ totrooms , ahs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ totrooms , ~ tenure , ahs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( ahs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ totrooms , ahs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ totrooms , ahs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ totrooms , ahs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ below_poverty , ahs_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( totrooms ~ below_poverty , ahs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ below_poverty + lotsize , ahs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( totrooms ~ below_poverty + lotsize , ahs_design ) summary( glm_result ) Replication Example This example matches the estimate and margin of error of the Total row of the General Housing tab from the AHS 2021 Table Specifications and PUF Estimates for User Verification: result <- svytotal( ~ as.numeric( intstatus == 1 ) , ahs_design ) stopifnot( round( coef( result ) / 1000 , 0 ) == 128504 ) ci_results <- confint( result , level = 0.9 ) stopifnot( round( ( ci_results[ 2 ] - coef( result ) ) / 1000 , 0 ) == 388 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for AHS users, this code replicates previously-presented examples: library(srvyr) ahs_srvyr_design <- as_survey( ahs_design ) Calculate the mean (average) of a linear variable, overall and by groups: ahs_srvyr_design %>% summarize( mean = survey_mean( totrooms , na.rm = TRUE ) ) ahs_srvyr_design %>% group_by( tenure ) %>% summarize( mean = survey_mean( totrooms , na.rm = TRUE ) ) "],["american-national-election-studies-anes.html", "American National Election Studies (ANES) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " American National Election Studies (ANES) A time series recording belief, public opinion, and political participation back to Dewey vs. Truman. Most tables contain one row per sampled eligible voter, varying weights like pre- and post-election. A complex sample generalizing to eligible voters in the U.S. with some panels to follow individuals. Core studies released quadrennially (presidential elections), plus pilot studies (often at midterms). Administered by a consortium of universities and funded by the National Science Foundation. Please skim before you begin: ANES 2020 Time Series Study Full Release: User Guide and Codebook How to Analyze ANES Survey Data This human-composed haiku or a bouquet of artificial intelligence-generated limericks # chez sacrificed queen # quadrennial bloodless coup # knight churchill's least worst Download, Import, Preparation Define a function to import a stata file as a data.frame: library(haven) anes_import_dta <- function( this_fn ){ this_tbl <- read_dta( this_fn ) this_tbl <- zap_labels( this_tbl ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) this_df } Register for the ANES Data Center at https://electionstudies.org/ Choose 2020 Time Series Study Download the STATA version of the February 10, 2022 file: library(haven) anes_fn <- file.path( path.expand( "~" ) , "anes_timeseries_2020_stata_20220210.dta" ) anes_df <- anes_import_dta( anes_fn ) Save locally   Save the object at any point: # anes_fn <- file.path( path.expand( "~" ) , "ANES" , "this_file.rds" ) # saveRDS( anes_df , file = anes_fn , compress = FALSE ) Load the same object: # anes_df <- readRDS( anes_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) anes_design <- svydesign( ids = ~ v200010c , strata = ~ v200010d , weights = ~ v200010a , data = subset( anes_df , v200010a > 0 ) , nest = TRUE ) Variable Recoding Add new columns to the data set: anes_design <- update( anes_design , one = 1 , democratic_party_rating = ifelse( v201156 %in% 0:100 , v201156 , NA ) , republican_party_rating = ifelse( v201157 %in% 0:100 , v201157 , NA ) , primary_voter = ifelse( v201020 %in% 1:2 , as.numeric( v201020 == 1 ) , NA ) , think_gov_spend_least = factor( v201645 , levels = 1:4 , labels = c( 'foreign aid (correct)' , 'medicare' , 'national defense' , 'social security' ) ) , undoc_kids = factor( v201423x , levels = 1:6 , labels = c( 'should sent back - favor a great deal' , 'should sent back - favor a moderate amount' , 'should sent back - favor a little' , 'should allow to stay - favor a little' , 'should allow to stay - favor a moderate amount' , 'should allow to stay - favor a great deal' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( anes_design , "sampling" ) != 0 ) svyby( ~ one , ~ undoc_kids , anes_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , anes_design ) svyby( ~ one , ~ undoc_kids , anes_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ republican_party_rating , anes_design , na.rm = TRUE ) svyby( ~ republican_party_rating , ~ undoc_kids , anes_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ think_gov_spend_least , anes_design , na.rm = TRUE ) svyby( ~ think_gov_spend_least , ~ undoc_kids , anes_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ republican_party_rating , anes_design , na.rm = TRUE ) svyby( ~ republican_party_rating , ~ undoc_kids , anes_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ think_gov_spend_least , anes_design , na.rm = TRUE ) svyby( ~ think_gov_spend_least , ~ undoc_kids , anes_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ republican_party_rating , anes_design , 0.5 , na.rm = TRUE ) svyby( ~ republican_party_rating , ~ undoc_kids , anes_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ republican_party_rating , denominator = ~ democratic_party_rating , anes_design , na.rm = TRUE ) Subsetting Restrict the survey design to party id: independent: sub_anes_design <- subset( anes_design , v201231x == 4 ) Calculate the mean (average) of this subset: svymean( ~ republican_party_rating , sub_anes_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ republican_party_rating , anes_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ republican_party_rating , ~ undoc_kids , anes_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( anes_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ republican_party_rating , anes_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ republican_party_rating , anes_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ republican_party_rating , anes_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ primary_voter , anes_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( republican_party_rating ~ primary_voter , anes_design ) Perform a chi-squared test of association for survey data: svychisq( ~ primary_voter + think_gov_spend_least , anes_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( republican_party_rating ~ primary_voter + think_gov_spend_least , anes_design ) summary( glm_result ) Replication Example This example matches statistics and standard errors in the Age rows of the ANES respondents (weighted) column of Table 1A from Benchmark and Attrition Report for the ANES 2016 Time Series Study: Log in to the ANES Data Center at https://electionstudies.org/ Choose 2016 Time Series Study. Download the DTA version of the September 4, 2019 file Download the DTA version of the Methodology File December 10, 2018 anes2016_fn <- file.path( path.expand( "~" ) , "anes_timeseries_2016.dta" ) anes2016_df <- anes_import_dta( anes2016_fn ) method2016_fn <- file.path( path.expand( "~" ) , "anes_timeseries_2016_methodology_dta.dta" ) method2016_df <- anes_import_dta( method2016_fn ) before_nrow <- nrow( anes2016_df ) anes2016_df <- merge( anes2016_df , method2016_df , by = 'v160001' ) stopifnot( nrow( anes2016_df ) == before_nrow ) anes2016_df[ , 'age_categories' ] <- factor( findInterval( anes2016_df[ , 'v161267' ] , c( 18 , seq( 30 , 70 , 10 ) ) ) , levels = 1:6 , labels = c( '18-29' , '30-39' , '40-49' , '50-59' , '60-69' , '70 or older' ) ) anes2016_design <- svrepdesign( data = subset( anes2016_df , v160101f > 0 ) , weights = ~ v160101f , repweights = 'weight_ftf_rkwt([0-9]+)' , type = 'JK1' , scale = 32 / 33 ) ( results <- svymean( ~ age_categories , anes2016_design , na.rm = TRUE ) ) published_results <- c( 0.21 , 0.158 , 0.156 , 0.2 , 0.147 , 0.129 ) published_standard_errors <- c( 0.0091 , 0.009 , 0.0094 , 0.0122 , 0.0069 , 0.0083 ) stopifnot( all( round( coef( results ) , 3 ) == published_results ) ) stopifnot( all( round( SE( results ) , 4 ) == published_standard_errors ) ) This example matches statistics and standard errors in the Age rows of the Design-consistent, with published strata column of Table 1 from How to Analyze ANES Survey Data: Log in to the ANES Data Center at https://electionstudies.org/ Choose 2004 Time Series Study4 Download the DTA version of the Full Release August 16, 2005 file Choose 2006 Pilot Study Download the DTA version of the April 26, 2007 file anes2004_fn <- file.path( path.expand( "~" ) , "anes2004TS.dta" ) anes2004_df <- anes_import_dta( anes2004_fn ) pilot2006_fn <- file.path( path.expand( "~" ) , "anes2006pilot.dta" ) pilot2006_df <- anes_import_dta( pilot2006_fn ) before_nrow <- nrow( pilot2006_df ) pilot2006_df <- merge( pilot2006_df , anes2004_df , by.x = 'v06p001' , by.y = 'v040001' ) stopifnot( nrow( pilot2006_df ) == before_nrow ) pilot2006_df[ , 'age_categories' ] <- factor( findInterval( pilot2006_df[ , 'v043250' ] , c( 18 , seq( 30 , 70 , 10 ) ) ) , levels = 1:6 , labels = c( '18-29' , '30-39' , '40-49' , '50-59' , '60-69' , '70 or older' ) ) pilot2006_design <- svydesign( id = ~v06p007b , strata = ~v06p007a , data = pilot2006_df , weights = ~v06p002 , nest = TRUE ) ( results <- svymean( ~ age_categories , pilot2006_design , na.rm = TRUE ) ) published_results <- c( 0.207 , 0.162 , 0.218 , 0.175 , 0.111 , 0.126 ) published_standard_errors <- c( 0.0251 , 0.024 , 0.022 , 0.0149 , 0.0125 , 0.0287 ) stopifnot( all( round( coef( results ) , 3 ) == published_results ) ) stopifnot( all( round( SE( results ) , 4 ) == published_standard_errors ) ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for ANES users, this code replicates previously-presented examples: library(srvyr) anes_srvyr_design <- as_survey( anes_design ) Calculate the mean (average) of a linear variable, overall and by groups: anes_srvyr_design %>% summarize( mean = survey_mean( republican_party_rating , na.rm = TRUE ) ) anes_srvyr_design %>% group_by( undoc_kids ) %>% summarize( mean = survey_mean( republican_party_rating , na.rm = TRUE ) ) "],["american-time-use-survey-atus.html", "American Time Use Survey (ATUS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " American Time Use Survey (ATUS) Sampled individuals write down everything they do for a single twenty-four hour period, in ten minute intervals. Time use data allows for the study of uncompensated work like cooking, chores, childcare. Many tables with structures described in the user guide, linkable to the Current Population Survey. A complex survey generalizing to person-hours among civilian non-institutional americans aged 15+. Released annually since 2003. Administered by the Bureau of Labor Statistics. Please skim before you begin: American Time Use Survey User’s Guide Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # don't judge me bruno # eat one hour, sleep the rest # it's my lazy day Download, Import, Preparation Define a function to download, unzip, and import each comma-separated value dat file: library(httr) atus_csv_import <- function( this_url ){ this_tf <- tempfile() this_dl <- GET( this_url , user_agent( "email@address.com") ) writeBin( content( this_dl ) , this_tf ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) this_dat <- grep( '\\\\.dat$' , unzipped_files , value = TRUE ) this_df <- read.csv( this_dat ) file.remove( c( this_tf , unzipped_files ) ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the activity, respondent, roster, and weights tables: act_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusact-2021.zip" ) resp_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusresp-2021.zip" ) rost_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusrost-2021.zip" ) wgts_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atuswgts-2021.zip" ) Specify which variables to keep in each of the data.frame objects: act_df <- act_df[ c( 'tucaseid' , 'tutier1code' , 'tutier2code' , 'tuactdur24' ) ] resp_df <- resp_df[ c( 'tucaseid' , 'tufinlwgt' , 'tulineno' ) ] rost_df <- rost_df[ , c( 'tucaseid' , 'tulineno' , 'teage' , 'tesex' ) ] Distribute travel-related activities (tutier1code == 18 from the lexicon) based on their second tier code: act_df[ act_df[ , 'tutier1code' ] == 18 & act_df[ , 'tutier2code' ] == 99 , 'tutier1code' ] <- 50 act_df[ act_df[ , 'tutier1code' ] == 18 , 'tutier1code' ] <- act_df[ act_df[ , 'tutier1code' ] == 18 , 'tutier2code' ] Sum up all durations at the (respondent x major activity category)-level: act_long_df <- aggregate( tuactdur24 ~ tucaseid + tutier1code , data = act_df , sum ) act_wide_df <- reshape( act_long_df , idvar = 'tucaseid' , timevar = 'tutier1code' , direction = 'wide' ) # for individuals not engaging in an activity category, replace missings with zero minutes act_wide_df[ is.na( act_wide_df ) ] <- 0 # for all columns except the respondent identifier, convert minutes to hours act_wide_df[ , -1 ] <- act_wide_df[ , -1 ] / 60 Merge the respondent and summed activity tables, then the roster table, and finally the replicate weights: resp_act_df <- merge( resp_df , act_wide_df ) stopifnot( nrow( resp_act_df ) == nrow( resp_df ) ) resp_act_rost_df <- merge( resp_act_df , rost_df ) stopifnot( nrow( resp_act_rost_df ) == nrow( resp_df ) ) atus_df <- merge( resp_act_rost_df , wgts_df ) stopifnot( nrow( atus_df ) == nrow( resp_df ) ) # remove dots from column names names( atus_df ) <- gsub( "\\\\." , "_" , names( atus_df ) ) atus_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # atus_fn <- file.path( path.expand( "~" ) , "ATUS" , "this_file.rds" ) # saveRDS( atus_df , file = atus_fn , compress = FALSE ) Load the same object: # atus_df <- readRDS( atus_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) atus_design <- svrepdesign( weights = ~ tufinlwgt , repweights = "finlwgt[0-9]" , type = "Fay" , rho = ( 1 - 1 / sqrt( 4 ) ) , mse = TRUE , data = atus_df ) Variable Recoding Add new columns to the data set: # caring for and helping household members is top level 03 from the lexicon # https://www.bls.gov/tus/lexicons/lexiconnoex2021.pdf atus_design <- update( atus_design , any_care = as.numeric( tuactdur24_3 > 0 ) , tesex = factor( tesex , levels = 1:2 , labels = c( 'male' , 'female' ) ) , age_category = factor( 1 + findInterval( teage , c( 18 , 35 , 65 ) ) , labels = c( "under 18" , "18 - 34" , "35 - 64" , "65 or older" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( atus_design , "sampling" ) != 0 ) svyby( ~ one , ~ age_category , atus_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , atus_design ) svyby( ~ one , ~ age_category , atus_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ tuactdur24_1 , atus_design ) svyby( ~ tuactdur24_1 , ~ age_category , atus_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ tesex , atus_design ) svyby( ~ tesex , ~ age_category , atus_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ tuactdur24_1 , atus_design ) svyby( ~ tuactdur24_1 , ~ age_category , atus_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ tesex , atus_design ) svyby( ~ tesex , ~ age_category , atus_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ tuactdur24_1 , atus_design , 0.5 ) svyby( ~ tuactdur24_1 , ~ age_category , atus_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ tuactdur24_5 , denominator = ~ tuactdur24_12 , atus_design ) Subsetting Restrict the survey design to any time volunteering: sub_atus_design <- subset( atus_design , tuactdur24_15 > 0 ) Calculate the mean (average) of this subset: svymean( ~ tuactdur24_1 , sub_atus_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ tuactdur24_1 , atus_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ tuactdur24_1 , ~ age_category , atus_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( atus_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ tuactdur24_1 , atus_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ tuactdur24_1 , atus_design , deff = TRUE ) # SRS with replacement svymean( ~ tuactdur24_1 , atus_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ any_care , atus_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( tuactdur24_1 ~ any_care , atus_design ) Perform a chi-squared test of association for survey data: svychisq( ~ any_care + tesex , atus_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( tuactdur24_1 ~ any_care + tesex , atus_design ) summary( glm_result ) Replication Example This example matches the “Caring for and helping household members” row of Table A-1: hours_per_day_civilian_population <- svymean( ~ tuactdur24_3 , atus_design ) stopifnot( round( coef( hours_per_day_civilian_population ) , 2 ) == 0.47 ) percent_engaged_per_day <- svymean( ~ any_care , atus_design ) stopifnot( round( coef( percent_engaged_per_day ) , 3 ) == 0.217 ) hours_per_day_among_engaged <- svymean( ~ tuactdur24_3 , subset( atus_design , any_care ) ) stopifnot( round( coef( hours_per_day_among_engaged ) , 2 ) == 2.17 ) This example matches the average hours and SE from Section 7.5 of the User’s Guide: Download and import the activity, activity summary, respondent, and weights tables: actsum07_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atussum_2007.zip" ) resp07_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusresp_2007.zip" ) act07_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atusact_2007.zip" ) wgts07_df <- atus_csv_import( "https://www.bls.gov/tus/datafiles/atuswgts_2007.zip" ) Option 1. Sum the two television fields from the activity summary file, removing zeroes: television_per_person <- data.frame( tucaseid = actsum07_df[ , 'tucaseid' ] , tuactdur24 = rowSums( actsum07_df[ , c( 't120303' , 't120304' ) ] ) ) television_per_person <- television_per_person[ television_per_person[ , 'tuactdur24' ] > 0 , ] Option 2. Limit the activity file to television watching records according to the 2007 Lexicon: television_activity <- subset( act07_df , tutier1code == 12 & tutier2code == 3 & tutier3code %in% 3:4 ) television_activity_summed <- aggregate( tuactdur24 ~ tucaseid , data = television_activity , sum ) Confirm both aggregation options yield the same results: stopifnot( all( television_per_person[ , 'tucaseid' ] == television_activity_summed[ , 'tucaseid' ] ) ) stopifnot( all( television_per_person[ , 'tuactdur24' ] == television_activity_summed[ , 'tuactdur24' ] ) ) Merge the respondent and summed activity tables, then the replicate weights: resp07_tpp_df <- merge( resp07_df[ , c( 'tucaseid' , 'tufinlwgt' ) ] , television_per_person , all.x = TRUE ) stopifnot( nrow( resp07_tpp_df ) == nrow( resp07_df ) ) # for individuals without television time, replace missings with zero minutes resp07_tpp_df[ is.na( resp07_tpp_df[ , 'tuactdur24' ] ) , 'tuactdur24' ] <- 0 # convert minutes to hours resp07_tpp_df[ , 'tuactdur24_hour' ] <- resp07_tpp_df[ , 'tuactdur24' ] / 60 atus07_df <- merge( resp07_tpp_df , wgts07_df ) stopifnot( nrow( atus07_df ) == nrow( resp07_df ) ) Construct a complex sample survey design: atus07_design <- svrepdesign( weights = ~ tufinlwgt , repweights = "finlwgt[0-9]" , type = "Fay" , rho = ( 1 - 1 / sqrt( 4 ) ) , data = atus07_df ) Match the statistic and SE of the number of hours daily that americans older than 14 watch tv: result <- svymean( ~ tuactdur24_hour , atus07_design ) stopifnot( round( coef( result ) , 2 ) == 2.62 ) stopifnot( round( SE( result ) , 4 ) == 0.0293 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for ATUS users, this code replicates previously-presented examples: library(srvyr) atus_srvyr_design <- as_survey( atus_design ) Calculate the mean (average) of a linear variable, overall and by groups: atus_srvyr_design %>% summarize( mean = survey_mean( tuactdur24_1 ) ) atus_srvyr_design %>% group_by( age_category ) %>% summarize( mean = survey_mean( tuactdur24_1 ) ) "],["behavioral-risk-factor-surveillance-system-brfss.html", "Behavioral Risk Factor Surveillance System (BRFSS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Behavioral Risk Factor Surveillance System (BRFSS) A health behavior telephone interview survey with enough sample size to examine all fifty states. One table with one row per telephone respondent. A complex survey designed to generalize to the civilian non-institutional adult population of the U.S. Released annually since 1984 but all states did not participate until 1994. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: BRFSS Data User Guide Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # a cellphone vibrates # it's the cdc! asking # if you ate veggies Download, Import, Preparation Download and import the national file: library(haven) zip_tf <- tempfile() zip_url <- "https://www.cdc.gov/brfss/annual_data/2022/files/LLCP2022XPT.zip" download.file( zip_url , zip_tf , mode = 'wb' ) brfss_tbl <- read_xpt( zip_tf ) brfss_df <- data.frame( brfss_tbl ) names( brfss_df ) <- tolower( names( brfss_df ) ) brfss_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # brfss_fn <- file.path( path.expand( "~" ) , "BRFSS" , "this_file.rds" ) # saveRDS( brfss_df , file = brfss_fn , compress = FALSE ) Load the same object: # brfss_df <- readRDS( brfss_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) variables_to_keep <- c( 'one' , 'x_psu' , 'x_ststr' , 'x_llcpwt' , 'genhlth' , 'medcost1' , 'x_state' , 'x_age80' , 'nummen' , 'numadult' , 'x_hlthpln' ) brfss_df <- brfss_df[ variables_to_keep ] brfss_national_design <- svydesign( id = ~ x_psu , strata = ~ x_ststr , data = brfss_df , weight = ~ x_llcpwt , nest = TRUE ) Since large linearized survey designs execute slowly, a replication design might be preferrable for exploratory analysis. Coefficients (such as means and medians) do not change, standard errors and confidence intervals differ slightly. The initial conversion with as.svrepdesign requires an extended period of processing time (perhaps run once overnight), subsequent analyses will finish much faster: # brfss_replication_design <- # as.svrepdesign( # brfss_national_design , # type = 'bootstrap' # ) # system.time( print( svymean( ~ x_age80 , brfss_national_design ) ) ) # system.time( print( svymean( ~ x_age80 , brfss_replication_design ) ) ) In this example, limit the national design to only Alaska for quicker processing: brfss_design <- subset( brfss_national_design , x_state %in% 2 ) Variable Recoding Add new columns to the data set: brfss_design <- update( brfss_design , fair_or_poor_health = ifelse( genhlth %in% 1:5 , as.numeric( genhlth > 3 ) , NA ) , no_doc_visit_due_to_cost = factor( medcost1 , levels = c( 1 , 2 , 7 , 9 ) , labels = c( "yes" , "no" , "dk" , "rf" ) ) , state_name = factor( x_state , levels = c(1, 2, 4, 5, 6, 8, 9, 10, 11, 12, 13, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 44, 45, 46, 47, 48, 49, 50, 51, 53, 54, 55, 56, 66, 72, 78) , labels = c("ALABAMA", "ALASKA", "ARIZONA", "ARKANSAS", "CALIFORNIA", "COLORADO", "CONNECTICUT", "DELAWARE", "DISTRICT OF COLUMBIA", "FLORIDA", "GEORGIA", "HAWAII", "IDAHO", "ILLINOIS", "INDIANA", "IOWA", "KANSAS", "KENTUCKY", "LOUISIANA", "MAINE", "MARYLAND", "MASSACHUSETTS", "MICHIGAN", "MINNESOTA", "MISSISSIPPI", "MISSOURI", "MONTANA", "NEBRASKA", "NEVADA", "NEW HAMPSHIRE", "NEW JERSEY", "NEW MEXICO", "NEW YORK", "NORTH CAROLINA", "NORTH DAKOTA", "OHIO", "OKLAHOMA", "OREGON", "PENNSYLVANIA", "RHODE ISLAND", "SOUTH CAROLINA", "SOUTH DAKOTA", "TENNESSEE", "TEXAS", "UTAH", "VERMONT", "VIRGINIA", "WASHINGTON", "WEST VIRGINIA", "WISCONSIN", "WYOMING", "GUAM", "PUERTO RICO", "U.S. VIRGIN ISLANDS") ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( brfss_design , "sampling" ) != 0 ) svyby( ~ one , ~ state_name , brfss_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , brfss_design ) svyby( ~ one , ~ state_name , brfss_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ x_age80 , brfss_design ) svyby( ~ x_age80 , ~ state_name , brfss_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ no_doc_visit_due_to_cost , brfss_design , na.rm = TRUE ) svyby( ~ no_doc_visit_due_to_cost , ~ state_name , brfss_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ x_age80 , brfss_design ) svyby( ~ x_age80 , ~ state_name , brfss_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ no_doc_visit_due_to_cost , brfss_design , na.rm = TRUE ) svyby( ~ no_doc_visit_due_to_cost , ~ state_name , brfss_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ x_age80 , brfss_design , 0.5 ) svyby( ~ x_age80 , ~ state_name , brfss_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ nummen , denominator = ~ numadult , brfss_design , na.rm = TRUE ) Subsetting Restrict the survey design to persons without health insurance: sub_brfss_design <- subset( brfss_design , x_hlthpln == 2 ) Calculate the mean (average) of this subset: svymean( ~ x_age80 , sub_brfss_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ x_age80 , brfss_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ x_age80 , ~ state_name , brfss_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( brfss_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ x_age80 , brfss_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ x_age80 , brfss_design , deff = TRUE ) # SRS with replacement svymean( ~ x_age80 , brfss_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ fair_or_poor_health , brfss_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( x_age80 ~ fair_or_poor_health , brfss_design ) Perform a chi-squared test of association for survey data: svychisq( ~ fair_or_poor_health + no_doc_visit_due_to_cost , brfss_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( x_age80 ~ fair_or_poor_health + no_doc_visit_due_to_cost , brfss_design ) summary( glm_result ) Replication Example This example matches Alaska’s confidence intervals from the BRFSS Prevalence & Trends Data: result <- svymean( ~ no_doc_visit_due_to_cost , subset( brfss_design , no_doc_visit_due_to_cost %in% c( 'yes' , 'no' ) ) , na.rm = TRUE ) stopifnot( round( confint( result )[ 1 , 1 ] , 3 ) == 0.092 ) stopifnot( round( confint( result )[ 1 , 2 ] , 3 ) == 0.114 ) stopifnot( round( confint( result )[ 2 , 1 ] , 3 ) == 0.886 ) stopifnot( round( confint( result )[ 2 , 2 ] , 3 ) == 0.908 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for BRFSS users, this code replicates previously-presented examples: library(srvyr) brfss_srvyr_design <- as_survey( brfss_design ) Calculate the mean (average) of a linear variable, overall and by groups: brfss_srvyr_design %>% summarize( mean = survey_mean( x_age80 ) ) brfss_srvyr_design %>% group_by( state_name ) %>% summarize( mean = survey_mean( x_age80 ) ) "],["consumer-expenditure-survey-ces.html", "Consumer Expenditure Survey (CES) Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Consumer Expenditure Survey (CES) A household budget survey designed to guide major economic indicators like the Consumer Price Index. One table of survey responses per quarter with one row per sampled household (consumer unit). Additional tables containing one record per expenditure. A complex sample survey designed to generalize to the civilian non-institutional U.S. population. Released annually since 1996. Administered by the Bureau of Labor Statistics. Please skim before you begin: Consumer Expenditure Surveys Public Use Microdata Getting Started Guide Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # price indices and # you spent how much on beans, jack? # pocketbook issues Download, Import, Preparation Download both the prior and current year of interview microdata: library(httr) tf_prior_year <- tempfile() this_url_prior_year <- "https://www.bls.gov/cex/pumd/data/stata/intrvw21.zip" dl_prior_year <- GET( this_url_prior_year , user_agent( "email@address.com" ) ) writeBin( content( dl_prior_year ) , tf_prior_year ) unzipped_files_prior_year <- unzip( tf_prior_year , exdir = tempdir() ) tf_current_year <- tempfile() this_url_current_year <- "https://www.bls.gov/cex/pumd/data/stata/intrvw22.zip" dl_current_year <- GET( this_url_current_year , user_agent( "email@address.com" ) ) writeBin( content( dl_current_year ) , tf_current_year ) unzipped_files_current_year <- unzip( tf_current_year , exdir = tempdir() ) unzipped_files <- c( unzipped_files_current_year , unzipped_files_prior_year ) Import and stack all 2022 quarterly files plus 2023’s first quarter: library(haven) fmli_files <- grep( "fmli2[2-3]" , unzipped_files , value = TRUE ) fmli_tbls <- lapply( fmli_files , read_dta ) fmli_dfs <- lapply( fmli_tbls , data.frame ) fmli_dfs <- lapply( fmli_dfs , function( w ){ names( w ) <- tolower( names( w ) ) ; w } ) fmli_cols <- lapply( fmli_dfs , names ) intersecting_cols <- Reduce( intersect , fmli_cols ) fmli_dfs <- lapply( fmli_dfs , function( w ) w[ intersecting_cols ] ) ces_df <- do.call( rbind , fmli_dfs ) Scale the weight columns based on the number of months in 2022: ces_df[ , c( 'qintrvyr' , 'qintrvmo' ) ] <- sapply( ces_df[ , c( 'qintrvyr' , 'qintrvmo' ) ] , as.numeric ) weight_columns <- grep( 'wt' , names( ces_df ) , value = TRUE ) ces_df <- transform( ces_df , mo_scope = ifelse( qintrvyr %in% 2022 & qintrvmo %in% 1:3 , qintrvmo - 1 , ifelse( qintrvyr %in% 2023 , 4 - qintrvmo , 3 ) ) ) for ( this_column in weight_columns ){ ces_df[ is.na( ces_df[ , this_column ] ) , this_column ] <- 0 ces_df[ , paste0( 'popwt_' , this_column ) ] <- ( ces_df[ , this_column ] * ces_df[ , 'mo_scope' ] / 12 ) } Combine previous quarter and current quarter variables into a single variable: expenditure_variables <- gsub( "pq$" , "" , grep( "pq$" , names( ces_df ) , value = TRUE ) ) # confirm that for every variable ending in pq, # there's the same variable ending in cq stopifnot( all( paste0( expenditure_variables , 'cq' ) %in% names( ces_df ) ) ) # confirm none of the variables without the pq or cq suffix exist if( any( expenditure_variables %in% names( ces_df ) ) ) stop( "variable conflict" ) for( this_column in expenditure_variables ){ ces_df[ , this_column ] <- rowSums( ces_df[ , paste0( this_column , c( 'pq' , 'cq' ) ) ] , na.rm = TRUE ) # annualize the quarterly spending ces_df[ , this_column ] <- 4 * ces_df[ , this_column ] ces_df[ is.na( ces_df[ , this_column ] ) , this_column ] <- 0 } Append any interview survey UCC found at https://www.bls.gov/cex/ce_source_integrate.xlsx: ucc_exp <- c( "450110" , "450210" ) mtbi_files <- grep( "mtbi2[2-3]" , unzipped_files , value = TRUE ) mtbi_tbls <- lapply( mtbi_files , read_dta ) mtbi_dfs <- lapply( mtbi_tbls , data.frame ) mtbi_dfs <- lapply( mtbi_dfs , function( w ){ names( w ) <- tolower( names( w ) ) ; w } ) mtbi_dfs <- lapply( mtbi_dfs , function( w ) w[ c( 'newid' , 'cost' , 'ucc' , 'ref_yr' ) ] ) mtbi_df <- do.call( rbind , mtbi_dfs ) mtbi_df <- subset( mtbi_df , ( ref_yr %in% 2022 ) & ( ucc %in% ucc_exp ) ) mtbi_agg <- aggregate( cost ~ newid , data = mtbi_df , sum ) names( mtbi_agg ) <- c( 'newid' , 'new_car_truck_exp' ) before_nrow <- nrow( ces_df ) ces_df <- merge( ces_df , mtbi_agg , all.x = TRUE ) stopifnot( nrow( ces_df ) == before_nrow ) ces_df[ is.na( ces_df[ , 'new_car_truck_exp' ] ) , 'new_car_truck_exp' ] <- 0 Save locally   Save the object at any point: # ces_fn <- file.path( path.expand( "~" ) , "CES" , "this_file.rds" ) # saveRDS( ces_df , file = ces_fn , compress = FALSE ) Load the same object: # ces_df <- readRDS( ces_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: Separate the ces_df data.frame into five implicates, each differing from the others only in the multiply-imputed variables: library(survey) library(mitools) # create a vector containing all of the multiply-imputed variables # (leaving the numbers off the end) mi_vars <- gsub( "5$" , "" , grep( "[a-z]5$" , names( ces_df ) , value = TRUE ) ) # loop through each of the five variables.. for ( i in 1:5 ){ # copy the 'ces_df' table over to a new temporary data frame 'x' x <- ces_df # loop through each of the multiply-imputed variables.. for ( j in mi_vars ){ # copy the contents of the current column (for example 'welfare1') # over to a new column ending in 'mi' (for example 'welfaremi') x[ , paste0( j , 'mi' ) ] <- x[ , paste0( j , i ) ] # delete the all five of the imputed variable columns x <- x[ , !( names( x ) %in% paste0( j , 1:5 ) ) ] } assign( paste0( 'imp' , i ) , x ) } ces_design <- svrepdesign( weights = ~ finlwt21 , repweights = "^wtrep[0-9][0-9]$" , data = imputationList( list( imp1 , imp2 , imp3 , imp4 , imp5 ) ) , type = "BRR" , combined.weights = TRUE , mse = TRUE ) Variable Recoding Add new columns to the data set: ces_design <- update( ces_design , one = 1 , any_food_stamp = as.numeric( jfs_amtmi > 0 ) , bls_urbn = factor( bls_urbn , levels = 1:2 , labels = c( 'urban' , 'rural' ) ) , sex_ref = factor( sex_ref , levels = 1:2 , labels = c( 'male' , 'female' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: MIcombine( with( ces_design , svyby( ~ one , ~ one , unwtd.count ) ) ) MIcombine( with( ces_design , svyby( ~ one , ~ bls_urbn , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: MIcombine( with( ces_design , svytotal( ~ one ) ) ) MIcombine( with( ces_design , svyby( ~ one , ~ bls_urbn , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: MIcombine( with( ces_design , svymean( ~ totexp ) ) ) MIcombine( with( ces_design , svyby( ~ totexp , ~ bls_urbn , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: MIcombine( with( ces_design , svymean( ~ sex_ref ) ) ) MIcombine( with( ces_design , svyby( ~ sex_ref , ~ bls_urbn , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: MIcombine( with( ces_design , svytotal( ~ totexp ) ) ) MIcombine( with( ces_design , svyby( ~ totexp , ~ bls_urbn , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: MIcombine( with( ces_design , svytotal( ~ sex_ref ) ) ) MIcombine( with( ces_design , svyby( ~ sex_ref , ~ bls_urbn , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: MIcombine( with( ces_design , svyquantile( ~ totexp , 0.5 , se = TRUE ) ) ) MIcombine( with( ces_design , svyby( ~ totexp , ~ bls_urbn , svyquantile , 0.5 , se = TRUE , ci = TRUE ) ) ) Estimate a ratio: MIcombine( with( ces_design , svyratio( numerator = ~ totexp , denominator = ~ fincbtxmi ) ) ) Subsetting Restrict the survey design to california residents: sub_ces_design <- subset( ces_design , state == '06' ) Calculate the mean (average) of this subset: MIcombine( with( sub_ces_design , svymean( ~ totexp ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- MIcombine( with( ces_design , svymean( ~ totexp ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- MIcombine( with( ces_design , svyby( ~ totexp , ~ bls_urbn , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( ces_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: MIcombine( with( ces_design , svyvar( ~ totexp ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement MIcombine( with( ces_design , svymean( ~ totexp , deff = TRUE ) ) ) # SRS with replacement MIcombine( with( ces_design , svymean( ~ totexp , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ any_food_stamp , ces_design , # method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( totexp ~ any_food_stamp , ces_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ any_food_stamp + sex_ref , ces_design ) Perform a survey-weighted generalized linear model: glm_result <- MIcombine( with( ces_design , svyglm( totexp ~ any_food_stamp + sex_ref ) ) ) summary( glm_result ) Replication Example This example matches the number of consumer units and the Cars and trucks, new rows of Table R-1: result <- MIcombine( with( ces_design , svytotal( ~ as.numeric( popwt_finlwt21 / finlwt21 ) ) ) ) stopifnot( round( coef( result ) , -3 ) == 134090000 ) results <- sapply( weight_columns , function( this_column ){ sum( ces_df[ , 'new_car_truck_exp' ] * ces_df[ , this_column ] ) / sum( ces_df[ , paste0( 'popwt_' , this_column ) ] ) } ) stopifnot( round( results[1] , 2 ) == 2195.30 ) standard_error <- sqrt( ( 1 / 44 ) * sum( ( results[-1] - results[1] )^2 ) ) stopifnot( round( standard_error , 2 ) == 174.02 ) # note the minor differences MIcombine( with( ces_design , svymean( ~ cartkn ) ) ) "],["census-of-governments-cog.html", "Census of Governments (COG) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Census of Governments (COG) Location, employment, and payroll for state and local (but not federal) government agencies in the U.S. One record per agency, one per agency function, plus the government units master address file. Complete enumeration of civilian employment in state and local governments in the 50 states + D.C. The Annual Survey of Public Employment & Payroll becomes a census in years ending with 2 and 7. Administered and financed by the US Census Bureau. Please skim before you begin: 2022 Census of Governments, Survey of Public Employment & Payroll Methodology Government Units Survey Methodology This human-composed haiku or a bouquet of artificial intelligence-generated limericks # courthouse steps wedding # schools police fire water # no fed mail invite Download, Import, Preparation Download, import, and stack the government units listing file: library(readxl) tf_gus <- tempfile() gus_url <- "https://www2.census.gov/programs-surveys/gus/datasets/2022/govt_units_2022.ZIP" download.file( gus_url , tf_gus , mode = 'wb' ) unzipped_files_gus <- unzip( tf_gus , exdir = tempdir() ) xlsx_gus_fn <- grep( "\\\\.xlsx$" , unzipped_files_gus , value = TRUE ) xlsx_sheets <- excel_sheets( xlsx_gus_fn ) # read all sheets into a list of tibbles gus_tbl_list <- lapply( xlsx_sheets , function( w ) read_excel( xlsx_gus_fn , sheet = w ) ) # convert all tibbles to data.frame objects gus_df_list <- lapply( gus_tbl_list , data.frame ) # lowercase all column names gus_df_list <- lapply( gus_df_list , function( w ){ names( w ) <- tolower( names( w ) ) ; w } ) # add the excel tab source to each data.frame for( i in seq( xlsx_sheets ) ) gus_df_list[[ i ]][ , 'source_tab' ] <- xlsx_sheets[ i ] # determine which columns are in all tables column_intersect <- Reduce( intersect , lapply( gus_df_list , names ) ) # determine which columns are in some but not all tables column_union <- unique( unlist( lapply( gus_df_list , names ) ) ) # these columns will be discarded by stacking: unique( unlist( lapply( lapply( gus_df_list , names ) , function( w ) column_union[ !column_union %in% w ] ) ) ) # stack all excel sheets, keeping only the columns that all tables have in common gus_df <- Reduce( rbind , lapply( gus_df_list , function( w ) w[ column_intersect ] ) ) Download and import the survey of public employment & payroll, one record per function (not per unit): tf_apes <- tempfile() apes_url <- paste0( "https://www2.census.gov/programs-surveys/apes/datasets/" , "2022/2022%20COG-E%20Individual%20Unit%20Files.zip" ) download.file( apes_url , tf_apes , mode = 'wb' ) unzipped_files_apes <- unzip( tf_apes , exdir = tempdir() ) xlsx_apes_fn <- grep( "\\\\.xlsx$" , unzipped_files_apes , value = TRUE ) apes_tbl <- read_excel( xlsx_apes_fn ) apes_df <- data.frame( apes_tbl ) names( apes_df ) <- tolower( names( apes_df ) ) Review the non-matching records between these two tables, then merge: # all DEP School Districts and a third of Special Districts are not in the `apes_df` table( gus_df[ , 'census_id_gidid' ] %in% apes_df[ , 'individual.unit.id' ] , gus_df[ , 'source_tab' ] , useNA = 'always' ) # state governments are not in the `gus_df` table( apes_df[ , 'individual.unit.id' ] %in% gus_df[ , 'census_id_gidid' ] , apes_df[ , 'type.of.government' ] , useNA = 'always' ) # check for overlapping field names: ( overlapping_names <- intersect( names( apes_df ) , names( gus_df ) ) ) # rename the state column in `gus_df` to state abbreviation names( gus_df )[ names( gus_df ) == 'state' ] <- 'stateab' double_df <- merge( apes_df , gus_df , by.x = 'individual.unit.id' , by.y = 'census_id_gidid' , all.x = TRUE ) stopifnot( nrow( double_df ) == nrow( apes_df ) ) # replace dots with underscores names( double_df ) <- gsub( "\\\\." , "_" , names( double_df ) ) Keep either the one record per agency rows or the one record per function rows: # `Total - All Government Employment Functions` records sum to the same as all other records: with( double_df , tapply( full_time_employees , grepl( "Total" , government_function ) , sum ) ) with( double_df , tapply( part_time_payroll , grepl( "Total" , government_function ) , sum ) ) # keep one record per government function (multiple records per agency): cog_df <- subset( double_df , !grepl( "Total" , government_function ) ) # keep one record per government agency: # cog_df <- subset( double_df , grepl( "Total" , government_function ) ) Save locally   Save the object at any point: # cog_fn <- file.path( path.expand( "~" ) , "COG" , "this_file.rds" ) # saveRDS( cog_df , file = cog_fn , compress = FALSE ) Load the same object: # cog_df <- readRDS( cog_fn ) Variable Recoding Add new columns to the data set: cog_df <- transform( cog_df , one = 1 , total_payroll = full_time_payroll + part_time_payroll , total_employees = full_time_employees + part_time_employees , any_full_time_employees = full_time_employees > 0 ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( cog_df ) table( cog_df[ , "type_of_government" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( cog_df[ , "full_time_employees" ] ) tapply( cog_df[ , "full_time_employees" ] , cog_df[ , "type_of_government" ] , mean ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( cog_df[ , "census_region" ] ) ) prop.table( table( cog_df[ , c( "census_region" , "type_of_government" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( cog_df[ , "full_time_employees" ] ) tapply( cog_df[ , "full_time_employees" ] , cog_df[ , "type_of_government" ] , sum ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( cog_df[ , "full_time_employees" ] , 0.5 ) tapply( cog_df[ , "full_time_employees" ] , cog_df[ , "type_of_government" ] , quantile , 0.5 ) Subsetting Limit your data.frame to Elementary, Secondary, Higher, and Other Educational Government Agencies: sub_cog_df <- subset( cog_df , grepl( 'Education' , government_function ) ) Calculate the mean (average) of this subset: mean( sub_cog_df[ , "full_time_employees" ] ) Measures of Uncertainty Calculate the variance, overall and by groups: var( cog_df[ , "full_time_employees" ] ) tapply( cog_df[ , "full_time_employees" ] , cog_df[ , "type_of_government" ] , var ) Regression Models and Tests of Association Perform a t-test: t.test( full_time_employees ~ any_full_time_employees , cog_df ) Perform a chi-squared test of association: this_table <- table( cog_df[ , c( "any_full_time_employees" , "census_region" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( full_time_employees ~ any_full_time_employees + census_region , data = cog_df ) summary( glm_result ) Replication Example This example matches excel cell “C17” of Employment & Payroll Data by State and by Function: financial_admin_df <- subset( cog_df , government_function == 'Financial Administration' ) stopifnot( sum( financial_admin_df[ , 'full_time_employees' ] ) == 404228 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for COG users, this code replicates previously-presented examples: library(dplyr) cog_tbl <- as_tibble( cog_df ) Calculate the mean (average) of a linear variable, overall and by groups: cog_tbl %>% summarize( mean = mean( full_time_employees ) ) cog_tbl %>% group_by( type_of_government ) %>% summarize( mean = mean( full_time_employees ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for COG users, this code replicates previously-presented examples: library(data.table) cog_dt <- data.table( cog_df ) Calculate the mean (average) of a linear variable, overall and by groups: cog_dt[ , mean( full_time_employees ) ] cog_dt[ , mean( full_time_employees ) , by = type_of_government ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for COG users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'cog' , cog_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( full_time_employees ) FROM cog' ) dbGetQuery( con , 'SELECT type_of_government , AVG( full_time_employees ) FROM cog GROUP BY type_of_government' ) "],["current-population-survey-cps.html", "Current Population Survey (CPS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " Current Population Survey (CPS) The principal labor force survey, providing income, poverty, and health insurance coverage estimates. One table with one row per sampled household, a second table with one row per family within each sampled household, and a third table with one row per individual within each of those families. A complex sample designed to generalize to the civilian non-institutional population of the US. Released annually since 1998, linkable to the Basic Monthly releases. Administered jointly by the US Census Bureau and the Bureau of Labor Statistics. Please skim before you begin: Current Population Survey 2023 Annual Social and Economic (ASEC) Supplement Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # jobs robbed by robot # luddite rebellion looming # blue, due to red pill Download, Import, Preparation Download and unzip the 2023 file: library(httr) tf <- tempfile() this_url <- "https://www2.census.gov/programs-surveys/cps/datasets/2023/march/asecpub23sas.zip" GET( this_url , write_disk( tf ) , progress() ) unzipped_files <- unzip( tf , exdir = tempdir() ) Import all four files: library(haven) four_tbl <- lapply( unzipped_files , read_sas ) four_df <- lapply( four_tbl , data.frame ) four_df <- lapply( four_df , function( w ){ names( w ) <- tolower( names( w ) ) ; w } ) household_df <- four_df[[ grep( 'hhpub' , basename( unzipped_files ) ) ]] family_df <- four_df[[ grep( 'ffpub' , basename( unzipped_files ) ) ]] person_df <- four_df[[ grep( 'pppub' , basename( unzipped_files ) ) ]] repwgts_df <- four_df[[ grep( 'repwgt' , basename( unzipped_files ) ) ]] Divide weights: household_df[ , 'hsup_wgt' ] <- household_df[ , 'hsup_wgt' ] / 100 family_df[ , 'fsup_wgt' ] <- family_df[ , 'fsup_wgt' ] / 100 for ( j in c( 'marsupwt' , 'a_ernlwt' , 'a_fnlwgt' ) ) person_df[ , j ] <- person_df[ , j ] / 100 Merge these four files: names( family_df )[ names( family_df ) == 'fh_seq' ] <- 'h_seq' names( person_df )[ names( person_df ) == 'ph_seq' ] <- 'h_seq' names( person_df )[ names( person_df ) == 'phf_seq' ] <- 'ffpos' hh_fm_df <- merge( household_df , family_df ) hh_fm_pr_df <- merge( hh_fm_df , person_df ) cps_df <- merge( hh_fm_pr_df , repwgts_df ) stopifnot( nrow( cps_df ) == nrow( person_df ) ) Save locally   Save the object at any point: # cps_fn <- file.path( path.expand( "~" ) , "CPS" , "this_file.rds" ) # saveRDS( cps_df , file = cps_fn , compress = FALSE ) Load the same object: # cps_df <- readRDS( cps_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) cps_design <- svrepdesign( weights = ~ marsupwt , repweights = "pwwgt[1-9]" , type = "Fay" , rho = ( 1 - 1 / sqrt( 4 ) ) , data = cps_df , combined.weights = TRUE , mse = TRUE ) Variable Recoding Add new columns to the data set: cps_design <- update( cps_design , one = 1 , a_maritl = factor( a_maritl , labels = c( "married - civilian spouse present" , "married - AF spouse present" , "married - spouse absent" , "widowed" , "divorced" , "separated" , "never married" ) ) , state_name = factor( gestfips , levels = c(1L, 2L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 12L, 13L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 53L, 54L, 55L, 56L) , labels = c("Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "District of Columbia", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming") ) , male = as.numeric( a_sex == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( cps_design , "sampling" ) != 0 ) svyby( ~ one , ~ state_name , cps_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , cps_design ) svyby( ~ one , ~ state_name , cps_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ ptotval , cps_design ) svyby( ~ ptotval , ~ state_name , cps_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ a_maritl , cps_design ) svyby( ~ a_maritl , ~ state_name , cps_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ ptotval , cps_design ) svyby( ~ ptotval , ~ state_name , cps_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ a_maritl , cps_design ) svyby( ~ a_maritl , ~ state_name , cps_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ ptotval , cps_design , 0.5 ) svyby( ~ ptotval , ~ state_name , cps_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ moop , denominator = ~ ptotval , cps_design ) Subsetting Restrict the survey design to persons aged 18-64: sub_cps_design <- subset( cps_design , a_age %in% 18:64 ) Calculate the mean (average) of this subset: svymean( ~ ptotval , sub_cps_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ ptotval , cps_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ ptotval , ~ state_name , cps_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( cps_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ ptotval , cps_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ ptotval , cps_design , deff = TRUE ) # SRS with replacement svymean( ~ ptotval , cps_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ male , cps_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( ptotval ~ male , cps_design ) Perform a chi-squared test of association for survey data: svychisq( ~ male + a_maritl , cps_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( ptotval ~ male + a_maritl , cps_design ) summary( glm_result ) Replication Example This example matches the count and share of individuals with health insurance in Table H-01: count_covered <- svytotal( ~ as.numeric( cov == 1 ) , cps_design ) stopifnot( round( coef( count_covered ) , -5 ) == 304000000 ) stopifnot( round( coef( count_covered ) - confint( count_covered , level = 0.9 )[1] , -3 ) == 746000 ) share_covered <- svymean( ~ as.numeric( cov == 1 ) , subset( cps_design , cov > 0 ) ) stopifnot( round( coef( share_covered ) , 3 ) == 0.921 ) stopifnot( round( coef( share_covered ) - confint( share_covered , level = 0.9 )[1] , 3 ) == 0.002 ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for CPS users, this code calculates the gini coefficient on complex sample survey data: library(convey) cps_design <- convey_prep( cps_design ) cps_household_design <- subset( cps_design , a_exprrp %in% 1:2 ) svygini( ~ htotval , cps_household_design ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for CPS users, this code replicates previously-presented examples: library(srvyr) cps_srvyr_design <- as_survey( cps_design ) Calculate the mean (average) of a linear variable, overall and by groups: cps_srvyr_design %>% summarize( mean = survey_mean( ptotval ) ) cps_srvyr_design %>% group_by( state_name ) %>% summarize( mean = survey_mean( ptotval ) ) "],["exame-nacional-de-desempenho-de-estudantes-enade.html", "Exame Nacional de Desempenho de Estudantes (ENADE) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Exame Nacional de Desempenho de Estudantes (ENADE) The nationwide mandatory examination of college graduates. One table with one row per individual undergraduate student in Brazil. An enumeration of undergraduate students in Brazil. Released annually since 2004. Compiled by the Instituto Nacional de Estudos e Pesquisas Educacionais Anísio Teixeira (INEP). Please skim before you begin: Cálculo da nota final do Exame Nacional de Desempenho dos Estudiantes Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # undergraduates # sit for standardized testing # exit interview Download, Import, Preparation Download, import, and merge two of the 2021 files: library(httr) library(archive) tf <- tempfile() this_url <- "https://download.inep.gov.br/microdados/microdados_enade_2021.zip" GET( this_url , write_disk( tf ) , progress() ) archive_extract( tf , dir = tempdir() ) read_enade_archive <- function( this_regular_expression , this_directory ){ this_filename <- grep( this_regular_expression , list.files( this_directory , recursive = TRUE , full.names = TRUE ) , value = TRUE ) this_df <- read.table( this_filename , header = TRUE , sep = ";" , na.strings = "" ) names( this_df ) <- tolower( names( this_df ) ) this_df } arq1_df <- read_enade_archive( 'arq1\\\\.txt$' , tempdir() ) arq1_df <- unique( arq1_df[ c( 'co_curso' , 'co_uf_curso' , 'co_categad' , 'co_grupo' ) ] ) arq3_df <- read_enade_archive( 'arq3\\\\.txt$' , tempdir() ) enade_df <- merge( arq3_df , arq1_df ) stopifnot( nrow( enade_df ) == nrow( arq3_df ) ) Save locally   Save the object at any point: # enade_fn <- file.path( path.expand( "~" ) , "ENADE" , "this_file.rds" ) # saveRDS( enade_df , file = enade_fn , compress = FALSE ) Load the same object: # enade_df <- readRDS( enade_fn ) Variable Recoding Add new columns to the data set: enade_df <- transform( enade_df , # qual foi o tempo gasto por voce para concluir a prova? less_than_two_hours = as.numeric( co_rs_i9 %in% c( 'A' , 'B' ) ) , administrative_category = factor( co_categad , levels = c( 1:5 , 7 ) , labels = c( '1. Pública Federal' , '2. Pública Estadual' , '3. Pública Municipal' , '4. Privada com fins lucrativos' , '5. Privada sem fins lucrativos' , '7. Especial' ) ) , state_name = factor( co_uf_curso , levels = c( 11:17 , 21:29 , 31:33 , 35 , 41:43 , 50:53 ) , labels = c( "Rondonia" , "Acre" , "Amazonas" , "Roraima" , "Para" , "Amapa" , "Tocantins" , "Maranhao" , "Piaui" , "Ceara" , "Rio Grande do Norte" , "Paraiba" , "Pernambuco" , "Alagoas" , "Sergipe" , "Bahia" , "Minas Gerais" , "Espirito Santo" , "Rio de Janeiro" , "Sao Paulo" , "Parana" , "Santa Catarina" , "Rio Grande do Sul" , "Mato Grosso do Sul" , "Mato Grosso" , "Goias" , "Distrito Federal" ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( enade_df ) table( enade_df[ , "administrative_category" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( enade_df[ , "nt_obj_fg" ] , na.rm = TRUE ) tapply( enade_df[ , "nt_obj_fg" ] , enade_df[ , "administrative_category" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( enade_df[ , "state_name" ] ) ) prop.table( table( enade_df[ , c( "state_name" , "administrative_category" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( enade_df[ , "nt_obj_fg" ] , na.rm = TRUE ) tapply( enade_df[ , "nt_obj_fg" ] , enade_df[ , "administrative_category" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( enade_df[ , "nt_obj_fg" ] , 0.5 , na.rm = TRUE ) tapply( enade_df[ , "nt_obj_fg" ] , enade_df[ , "administrative_category" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to students reporting that the general training section was easy or very easy: sub_enade_df <- subset( enade_df , co_rs_i1 %in% c( "A" , "B" ) ) Calculate the mean (average) of this subset: mean( sub_enade_df[ , "nt_obj_fg" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( enade_df[ , "nt_obj_fg" ] , na.rm = TRUE ) tapply( enade_df[ , "nt_obj_fg" ] , enade_df[ , "administrative_category" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( nt_obj_fg ~ less_than_two_hours , enade_df ) Perform a chi-squared test of association: this_table <- table( enade_df[ , c( "less_than_two_hours" , "state_name" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( nt_obj_fg ~ less_than_two_hours + state_name , data = enade_df ) summary( glm_result ) Replication Example This example matches the tecnologia em gestão da tecnologia da informação test scores on PDF page 48 of the 2021 final results document: it_students <- subset( enade_df , co_grupo %in% 6409 ) results <- sapply( it_students[ c( 'nt_fg' , 'nt_ce' , 'nt_ger' ) ] , mean , na.rm = TRUE ) stopifnot( round( results[ 'nt_fg' ] , 1 ) == 30.4 ) stopifnot( round( results[ 'nt_ce' ] , 1 ) == 38.2 ) stopifnot( round( results[ 'nt_ger' ] , 1 ) == 36.3 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for ENADE users, this code replicates previously-presented examples: library(dplyr) enade_tbl <- as_tibble( enade_df ) Calculate the mean (average) of a linear variable, overall and by groups: enade_tbl %>% summarize( mean = mean( nt_obj_fg , na.rm = TRUE ) ) enade_tbl %>% group_by( administrative_category ) %>% summarize( mean = mean( nt_obj_fg , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for ENADE users, this code replicates previously-presented examples: library(data.table) enade_dt <- data.table( enade_df ) Calculate the mean (average) of a linear variable, overall and by groups: enade_dt[ , mean( nt_obj_fg , na.rm = TRUE ) ] enade_dt[ , mean( nt_obj_fg , na.rm = TRUE ) , by = administrative_category ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for ENADE users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'enade' , enade_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( nt_obj_fg ) FROM enade' ) dbGetQuery( con , 'SELECT administrative_category , AVG( nt_obj_fg ) FROM enade GROUP BY administrative_category' ) "],["exame-nacional-do-ensino-medio-enem.html", "Exame Nacional do Ensino Medio (ENEM) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Exame Nacional do Ensino Medio (ENEM) The national student aptitude test, used to assess high school completion and university admission. One table with one row per test-taking student, a second of study habit questionnaire respondents. Updated annually since 1998. Maintained by Brazil’s Instituto Nacional de Estudos e Pesquisas Educacionais Anisio Teixeira Please skim before you begin: Leia_Me_Enem included in each annual zipped file Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # graduation stage # shake hands, toss cap, unroll scroll, # mais um exame? Download, Import, Preparation Download and unzip the 2022 file: library(httr) library(archive) tf <- tempfile() this_url <- "https://download.inep.gov.br/microdados/microdados_enem_2022.zip" GET( this_url , write_disk( tf ) , progress() ) archive_extract( tf , dir = tempdir() ) Import the 2022 file: library(readr) enem_fns <- list.files( tempdir() , recursive = TRUE , full.names = TRUE ) enem_fn <- grep( "MICRODADOS_ENEM_([0-9][0-9][0-9][0-9])\\\\.csv$" , enem_fns , value = TRUE ) enem_tbl <- read_csv2( enem_fn , locale = locale( encoding = 'latin1' ) ) enem_df <- data.frame( enem_tbl ) names( enem_df ) <- tolower( names( enem_df ) ) Save locally   Save the object at any point: # enem_fn <- file.path( path.expand( "~" ) , "ENEM" , "this_file.rds" ) # saveRDS( enem_df , file = enem_fn , compress = FALSE ) Load the same object: # enem_df <- readRDS( enem_fn ) Variable Recoding Add new columns to the data set: enem_df <- transform( enem_df , domestic_worker = as.numeric( q007 %in% c( 'B' , 'C' , 'D' ) ) , administrative_category = factor( tp_dependencia_adm_esc , levels = 1:4 , labels = c( 'Federal' , 'Estadual' , 'Municipal' , 'Privada' ) ) , state_name = factor( co_uf_esc , levels = c( 11:17 , 21:29 , 31:33 , 35 , 41:43 , 50:53 ) , labels = c( "Rondonia" , "Acre" , "Amazonas" , "Roraima" , "Para" , "Amapa" , "Tocantins" , "Maranhao" , "Piaui" , "Ceara" , "Rio Grande do Norte" , "Paraiba" , "Pernambuco" , "Alagoas" , "Sergipe" , "Bahia" , "Minas Gerais" , "Espirito Santo" , "Rio de Janeiro" , "Sao Paulo" , "Parana" , "Santa Catarina" , "Rio Grande do Sul" , "Mato Grosso do Sul" , "Mato Grosso" , "Goias" , "Distrito Federal" ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( enem_df ) table( enem_df[ , "administrative_category" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( enem_df[ , "nu_nota_mt" ] , na.rm = TRUE ) tapply( enem_df[ , "nu_nota_mt" ] , enem_df[ , "administrative_category" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( enem_df[ , "state_name" ] ) ) prop.table( table( enem_df[ , c( "state_name" , "administrative_category" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( enem_df[ , "nu_nota_mt" ] , na.rm = TRUE ) tapply( enem_df[ , "nu_nota_mt" ] , enem_df[ , "administrative_category" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( enem_df[ , "nu_nota_mt" ] , 0.5 , na.rm = TRUE ) tapply( enem_df[ , "nu_nota_mt" ] , enem_df[ , "administrative_category" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to mother graduated from high school: sub_enem_df <- subset( enem_df , q002 %in% c( 'E' , 'F' , 'G' ) ) Calculate the mean (average) of this subset: mean( sub_enem_df[ , "nu_nota_mt" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( enem_df[ , "nu_nota_mt" ] , na.rm = TRUE ) tapply( enem_df[ , "nu_nota_mt" ] , enem_df[ , "administrative_category" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( nu_nota_mt ~ domestic_worker , enem_df ) Perform a chi-squared test of association: this_table <- table( enem_df[ , c( "domestic_worker" , "state_name" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( nu_nota_mt ~ domestic_worker + state_name , data = enem_df ) summary( glm_result ) Replication Example This example matches the registration counts in the Sinopse ENEM 2022 Excel table: stopifnot( nrow( enem_df ) == 3476105 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for ENEM users, this code replicates previously-presented examples: library(dplyr) enem_tbl <- as_tibble( enem_df ) Calculate the mean (average) of a linear variable, overall and by groups: enem_tbl %>% summarize( mean = mean( nu_nota_mt , na.rm = TRUE ) ) enem_tbl %>% group_by( administrative_category ) %>% summarize( mean = mean( nu_nota_mt , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for ENEM users, this code replicates previously-presented examples: library(data.table) enem_dt <- data.table( enem_df ) Calculate the mean (average) of a linear variable, overall and by groups: enem_dt[ , mean( nu_nota_mt , na.rm = TRUE ) ] enem_dt[ , mean( nu_nota_mt , na.rm = TRUE ) , by = administrative_category ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for ENEM users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'enem' , enem_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( nu_nota_mt ) FROM enem' ) dbGetQuery( con , 'SELECT administrative_category , AVG( nu_nota_mt ) FROM enem GROUP BY administrative_category' ) "],["european-social-survey-ess.html", "European Social Survey (ESS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " European Social Survey (ESS) The barometer of political opinion and behavior across the continent. One table per country with one row per sampled respondent. A complex sample designed to generalize to residents aged 15 and older in participating nations. Released biennially since 2002. Headquartered at City, University of London and governed by a scientific team across Europe. Please skim before you begin: Findings from the European Social Survey Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # pent up belief gauge # open border monarchists # survey for your thoughts Download, Import, Preparation Register at the ESS Data Portal at https://ess-search.nsd.no/. Choose ESS round 8 - 2016. Welfare attitudes, Attitudes to climate change. Download the integrated file and also the sample design (SDDF) files as SAV (SPSS) files: library(foreign) ess_int_df <- read.spss( file.path( path.expand( "~" ) , "ESS8e02_2.sav" ) , to.data.frame = TRUE , use.value.labels = FALSE ) ess_sddf_df <- read.spss( file.path( path.expand( "~" ) , "ESS8SDDFe01_1.sav" ) , to.data.frame = TRUE , use.value.labels = FALSE ) ess_df <- merge( ess_int_df , ess_sddf_df , by = c( 'cntry' , 'idno' ) ) stopifnot( nrow( ess_df ) == nrow( ess_int_df ) ) Save locally   Save the object at any point: # ess_fn <- file.path( path.expand( "~" ) , "ESS" , "this_file.rds" ) # saveRDS( ess_df , file = ess_fn , compress = FALSE ) Load the same object: # ess_df <- readRDS( ess_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) options( survey.lonely.psu = "adjust" ) ess_df[ , 'anweight' ] <- ess_df[ , 'pspwght' ] * ess_df[ , 'pweight' ] * 10000 ess_design <- svydesign( ids = ~psu , strata = ~stratum , weights = ~anweight , data = ess_df , nest = TRUE ) Variable Recoding Add new columns to the data set: ess_design <- update( ess_design , one = 1 , gndr = factor( gndr , labels = c( 'male' , 'female' ) ) , netusoft = factor( netusoft , levels = 1:5 , labels = c( 'Never' , 'Only occasionally' , 'A few times a week' , 'Most days' , 'Every day' ) ) , belonging_to_particular_religion = as.numeric( rlgblg == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( ess_design , "sampling" ) != 0 ) svyby( ~ one , ~ cntry , ess_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , ess_design ) svyby( ~ one , ~ cntry , ess_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ ppltrst , ess_design , na.rm = TRUE ) svyby( ~ ppltrst , ~ cntry , ess_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ gndr , ess_design , na.rm = TRUE ) svyby( ~ gndr , ~ cntry , ess_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ ppltrst , ess_design , na.rm = TRUE ) svyby( ~ ppltrst , ~ cntry , ess_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ gndr , ess_design , na.rm = TRUE ) svyby( ~ gndr , ~ cntry , ess_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ ppltrst , ess_design , 0.5 , na.rm = TRUE ) svyby( ~ ppltrst , ~ cntry , ess_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ ppltrst , denominator = ~ pplfair , ess_design , na.rm = TRUE ) Subsetting Restrict the survey design to voters: sub_ess_design <- subset( ess_design , vote == 1 ) Calculate the mean (average) of this subset: svymean( ~ ppltrst , sub_ess_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ ppltrst , ess_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ ppltrst , ~ cntry , ess_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( ess_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ ppltrst , ess_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ ppltrst , ess_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ ppltrst , ess_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ belonging_to_particular_religion , ess_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( ppltrst ~ belonging_to_particular_religion , ess_design ) Perform a chi-squared test of association for survey data: svychisq( ~ belonging_to_particular_religion + gndr , ess_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( ppltrst ~ belonging_to_particular_religion + gndr , ess_design ) summary( glm_result ) Replication Example This example matches statistics and confidence intervals within 0.1% from the Guide to Using Weights and Sample Design Indicators with ESS Data: published_proportions <- c( 0.166 , 0.055 , 0.085 , 0.115 , 0.578 ) published_lb <- c( 0.146 , 0.045 , 0.072 , 0.099 , 0.550 ) published_ub <- c( 0.188 , 0.068 , 0.100 , 0.134 , 0.605 ) austrians <- subset( ess_design , cntry == 'AT' ) ( results <- svymean( ~ netusoft , austrians , na.rm = TRUE ) ) stopifnot( all( round( coef( results ) , 3 ) == published_proportions ) ) ( ci_results <- confint( results ) ) stopifnot( all( abs( ci_results[ , 1 ] - published_lb ) < 0.0015 ) ) stopifnot( all( abs( ci_results[ , 2 ] - published_ub ) < 0.0015 ) ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for ESS users, this code replicates previously-presented examples: library(srvyr) ess_srvyr_design <- as_survey( ess_design ) Calculate the mean (average) of a linear variable, overall and by groups: ess_srvyr_design %>% summarize( mean = survey_mean( ppltrst , na.rm = TRUE ) ) ess_srvyr_design %>% group_by( cntry ) %>% summarize( mean = survey_mean( ppltrst , na.rm = TRUE ) ) "],["fda-adverse-event-reporting-system-faers.html", "FDA Adverse Event Reporting System (FAERS) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " FDA Adverse Event Reporting System (FAERS) The post-marketing safety surveillance program for drug and therapeutic biological products. Multiple tables linked by primaryid including demographics, outcomes, drug start and end dates. Voluntary reports from practitioners and patients, not representative, no verification of causality. Published quarterly since 2004, file structure revisions at 2012Q4 and 2014Q3. Maintained by the United States Food and Drug Administration (FDA). Please skim before you begin: ASC_NTS.DOC included in each quarterly zipped file, especially the Entity Relationship Diagram Questions and Answers on FDA’s Adverse Event Reporting System (FAERS) This human-composed haiku or a bouquet of artificial intelligence-generated limericks # side effect guestbook # violet you're turning violet # vi'lent dose response Download, Import, Preparation Download the quarterly file: library(httr) tf <- tempfile() this_url <- "https://fis.fda.gov/content/Exports/faers_ascii_2023q1.zip" GET( this_url , write_disk( tf ) , progress() ) unzipped_files <- unzip( tf , exdir = tempdir() ) Define a function to import each text file: read_faers <- function( this_fn ){ read.table( this_fn , sep = "$" , header = TRUE , comment.char = "" , quote = "" ) } Import multiple tables from the downloaded quarter of microdata: # one record per report faers_demo_df <- read_faers( grep( 'DEMO23Q1\\\\.txt$' , unzipped_files , value = TRUE ) ) # one or more record per report faers_drug_df <- read_faers( grep( 'DRUG23Q1\\\\.txt$' , unzipped_files , value = TRUE ) ) # zero or more records per report faers_outcome_df <- read_faers( grep( 'OUTC23Q1\\\\.txt$' , unzipped_files , value = TRUE ) ) Construct an analysis file limited to reported deaths: # limit the outcome file to deaths faers_deaths_df <- subset( faers_outcome_df , outc_cod == 'DE' ) # merge demographics with each reported death faers_df <- merge( faers_demo_df , faers_deaths_df ) # confirm that the analysis file matches the number of death outcomes stopifnot( nrow( faers_deaths_df ) == nrow( faers_df ) ) # confirm zero reports include multiple deaths from the same reported adverse event stopifnot( nrow( faers_df ) == length( unique( faers_df[ , 'primaryid' ] ) ) ) Save locally   Save the object at any point: # faers_fn <- file.path( path.expand( "~" ) , "FAERS" , "this_file.rds" ) # saveRDS( faers_df , file = faers_fn , compress = FALSE ) Load the same object: # faers_df <- readRDS( faers_fn ) Variable Recoding Add new columns to the data set: faers_df <- transform( faers_df , physician_reported = as.numeric( occp_cod == "MD" ) , reporter_country_categories = ifelse( reporter_country == 'US' , 'USA' , ifelse( reporter_country == 'COUNTRY NOT SPECIFIED' , 'missing' , ifelse( reporter_country == 'JP' , 'Japan' , ifelse( reporter_country == 'UK' , 'UK' , ifelse( reporter_country == 'CA' , 'Canada' , ifelse( reporter_country == 'FR' , 'France' , 'Other' ) ) ) ) ) ) , init_fda_year = as.numeric( substr( init_fda_dt , 1 , 4 ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( faers_df ) table( faers_df[ , "reporter_country_categories" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( faers_df[ , "init_fda_year" ] , na.rm = TRUE ) tapply( faers_df[ , "init_fda_year" ] , faers_df[ , "reporter_country_categories" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( faers_df[ , "sex" ] ) ) prop.table( table( faers_df[ , c( "sex" , "reporter_country_categories" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( faers_df[ , "init_fda_year" ] , na.rm = TRUE ) tapply( faers_df[ , "init_fda_year" ] , faers_df[ , "reporter_country_categories" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( faers_df[ , "init_fda_year" ] , 0.5 , na.rm = TRUE ) tapply( faers_df[ , "init_fda_year" ] , faers_df[ , "reporter_country_categories" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to elderly persons: sub_faers_df <- subset( faers_df , age_grp == "E" ) Calculate the mean (average) of this subset: mean( sub_faers_df[ , "init_fda_year" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( faers_df[ , "init_fda_year" ] , na.rm = TRUE ) tapply( faers_df[ , "init_fda_year" ] , faers_df[ , "reporter_country_categories" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( init_fda_year ~ physician_reported , faers_df ) Perform a chi-squared test of association: this_table <- table( faers_df[ , c( "physician_reported" , "sex" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( init_fda_year ~ physician_reported + sex , data = faers_df ) summary( glm_result ) Replication Example This example matches the death frequency counts in the OUTC23Q1.pdf file in the downloaded quarter: stopifnot( nrow( faers_df ) == 37704 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for FAERS users, this code replicates previously-presented examples: library(dplyr) faers_tbl <- as_tibble( faers_df ) Calculate the mean (average) of a linear variable, overall and by groups: faers_tbl %>% summarize( mean = mean( init_fda_year , na.rm = TRUE ) ) faers_tbl %>% group_by( reporter_country_categories ) %>% summarize( mean = mean( init_fda_year , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for FAERS users, this code replicates previously-presented examples: library(data.table) faers_dt <- data.table( faers_df ) Calculate the mean (average) of a linear variable, overall and by groups: faers_dt[ , mean( init_fda_year , na.rm = TRUE ) ] faers_dt[ , mean( init_fda_year , na.rm = TRUE ) , by = reporter_country_categories ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for FAERS users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'faers' , faers_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( init_fda_year ) FROM faers' ) dbGetQuery( con , 'SELECT reporter_country_categories , AVG( init_fda_year ) FROM faers GROUP BY reporter_country_categories' ) "],["general-social-survey-gss.html", "General Social Survey (GSS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " General Social Survey (GSS) A historical record of the concerns, experiences, attitudes, and practices of residents of the United States. Both cross-sectional and panel tables with one row per sampled respondent. A complex sample survey generalizing to non-institutionalized adults (18+) in the United States. Updated biennially since 1972. Funded by National Science Foundation, administered by the National Opinion Research Center. Please skim before you begin: DOCUMENTATION AND PUBLIC USE FILE CODEBOOK (Release 1) Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # chat about who will # be allowed marriage, children. # first date questionnaire Download, Import, Preparation Download and import the 1972-2022 cumulative data file: library(haven) zip_tf <- tempfile() zip_url <- "https://gss.norc.org/Documents/sas/GSS_sas.zip" download.file( zip_url , zip_tf , mode = 'wb' ) unzipped_files <- unzip( zip_tf , exdir = tempdir() ) gss_tbl <- read_sas( grep( '\\\\.sas7bdat$' , unzipped_files , value = TRUE ) ) gss_df <- data.frame( gss_tbl ) names( gss_df ) <- tolower( names( gss_df ) ) gss_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # gss_fn <- file.path( path.expand( "~" ) , "GSS" , "this_file.rds" ) # saveRDS( gss_df , file = gss_fn , compress = FALSE ) Load the same object: # gss_df <- readRDS( gss_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) options( survey.lonely.psu = "adjust" ) gss_design <- svydesign( ~ vpsu , strata = ~ interaction( year , vstrat ) , data = subset( gss_df , year >= 1975 ) , weights = ~ wtsscomp , nest = TRUE ) Variable Recoding Add new columns to the data set: gss_design <- update( gss_design , polviews = factor( polviews , levels = 1:7 , labels = c( "Extremely liberal" , "Liberal" , "Slightly liberal" , "Moderate, middle of the road" , "Slightly conservative" , "Conservative" , "Extremely conservative" ) ) , born_in_usa = as.numeric( born == 1 ) , race = factor( race , levels = 1:3 , labels = c( "white" , "black" , "other" ) ) , region = factor( region , levels = 1:9 , labels = c( "New England" , "Middle Atlantic" , "East North Central" , "West North Central" , "South Atlantic" , "East South Central" , "West South Central" , "Mountain" , "Pacific" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( gss_design , "sampling" ) != 0 ) svyby( ~ one , ~ region , gss_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , gss_design ) svyby( ~ one , ~ region , gss_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ age , gss_design , na.rm = TRUE ) svyby( ~ age , ~ region , gss_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ race , gss_design , na.rm = TRUE ) svyby( ~ race , ~ region , gss_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ age , gss_design , na.rm = TRUE ) svyby( ~ age , ~ region , gss_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ race , gss_design , na.rm = TRUE ) svyby( ~ race , ~ region , gss_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ age , gss_design , 0.5 , na.rm = TRUE ) svyby( ~ age , ~ region , gss_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ adults , denominator = ~ hompop , gss_design , na.rm = TRUE ) Subsetting Restrict the survey design to females: sub_gss_design <- subset( gss_design , sex == 2 ) Calculate the mean (average) of this subset: svymean( ~ age , sub_gss_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ age , gss_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ age , ~ region , gss_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( gss_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ age , gss_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ age , gss_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ age , gss_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ born_in_usa , gss_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( age ~ born_in_usa , gss_design ) Perform a chi-squared test of association for survey data: svychisq( ~ born_in_usa + race , gss_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( age ~ born_in_usa + race , gss_design ) summary( glm_result ) Replication Example Match the unweighted record count on PDF page 10 of the Public Use File codebook: stopifnot( nrow( subset( gss_design , year == 2022 ) ) == 3544 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for GSS users, this code replicates previously-presented examples: library(srvyr) gss_srvyr_design <- as_survey( gss_design ) Calculate the mean (average) of a linear variable, overall and by groups: gss_srvyr_design %>% summarize( mean = survey_mean( age , na.rm = TRUE ) ) gss_srvyr_design %>% group_by( region ) %>% summarize( mean = survey_mean( age , na.rm = TRUE ) ) "],["medicare-current-beneficiary-survey-mcbs.html", "Medicare Current Beneficiary Survey (MCBS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Medicare Current Beneficiary Survey (MCBS) The monitoring system for Medicare enrollees in the United States on topics not available in the program’s administrative data, such as out of pocket expenditure and beneficiary satisfaction. Survey and supplemental tables with one row per sampled individual, although downloadable datasets not linkable. A complex sample survey designed to generalize to all elderly and disabled individuals with at least one month of program enrollment during the calendar year. Released annually as a public use file since 2015. Conducted by the Office of Enterprise Data and Analytics (OEDA) of the Centers for Medicare & Medicaid Services (CMS) through a contract with NORC at the University of Chicago. Please skim before you begin: MCBS Methodology Report MCBS Advanced Tutorial on Weighting and Variance Estimation This human-composed haiku or a bouquet of artificial intelligence-generated limericks # old, or disabled # access to medical care, # utilization Download, Import, Preparation tf <- tempfile() this_url <- "https://www.cms.gov/files/zip/cspuf2019.zip" download.file( this_url , tf , mode = 'wb' ) unzipped_files <- unzip( tf , exdir = tempdir() ) mcbs_csv <- grep( '\\\\.csv$' , unzipped_files , value = TRUE ) mcbs_df <- read.csv( mcbs_csv ) names( mcbs_df ) <- tolower( names( mcbs_df ) ) Save locally   Save the object at any point: # mcbs_fn <- file.path( path.expand( "~" ) , "MCBS" , "this_file.rds" ) # saveRDS( mcbs_df , file = mcbs_fn , compress = FALSE ) Load the same object: # mcbs_df <- readRDS( mcbs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) mcbs_design <- svrepdesign( weight = ~cspufwgt , repweights = 'cspuf[0-9]+' , mse = TRUE , type = 'Fay' , rho = 0.3 , data = mcbs_df ) Variable Recoding Add new columns to the data set: mcbs_design <- update( mcbs_design , one = 1 , csp_age = factor( csp_age , levels = 1:3 , labels = c( '01: younger than 65' , '02: 65 to 74' , '03: 75 or older' ) ) , two_or_more_chronic_conditions = as.numeric( csp_nchrncnd > 1 ) , csp_sex = factor( csp_sex , labels = c( 'male' , 'female' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( mcbs_design , "sampling" ) != 0 ) svyby( ~ one , ~ csp_age , mcbs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , mcbs_design ) svyby( ~ one , ~ csp_age , mcbs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ pamtoop , mcbs_design ) svyby( ~ pamtoop , ~ csp_age , mcbs_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ csp_sex , mcbs_design ) svyby( ~ csp_sex , ~ csp_age , mcbs_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ pamtoop , mcbs_design ) svyby( ~ pamtoop , ~ csp_age , mcbs_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ csp_sex , mcbs_design ) svyby( ~ csp_sex , ~ csp_age , mcbs_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ pamtoop , mcbs_design , 0.5 ) svyby( ~ pamtoop , ~ csp_age , mcbs_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ pamtoop , denominator = ~ pamttot , mcbs_design ) Subsetting Restrict the survey design to household income below $25,000: sub_mcbs_design <- subset( mcbs_design , csp_income == 1 ) Calculate the mean (average) of this subset: svymean( ~ pamtoop , sub_mcbs_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ pamtoop , mcbs_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ pamtoop , ~ csp_age , mcbs_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( mcbs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ pamtoop , mcbs_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ pamtoop , mcbs_design , deff = TRUE ) # SRS with replacement svymean( ~ pamtoop , mcbs_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ two_or_more_chronic_conditions , mcbs_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( pamtoop ~ two_or_more_chronic_conditions , mcbs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ two_or_more_chronic_conditions + csp_sex , mcbs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( pamtoop ~ two_or_more_chronic_conditions + csp_sex , mcbs_design ) summary( glm_result ) Replication Example This example matches the weighted total from the 2019 Data User’s Guide: Cost Supplement File Public Use File: stopifnot( round( coef( svytotal( ~ one , mcbs_design ) ) , 0 ) == 56307461 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for MCBS users, this code replicates previously-presented examples: library(srvyr) mcbs_srvyr_design <- as_survey( mcbs_design ) Calculate the mean (average) of a linear variable, overall and by groups: mcbs_srvyr_design %>% summarize( mean = survey_mean( pamtoop ) ) mcbs_srvyr_design %>% group_by( csp_age ) %>% summarize( mean = survey_mean( pamtoop ) ) "],["medical-expenditure-panel-survey-meps.html", "Medical Expenditure Panel Survey (MEPS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Medical Expenditure Panel Survey (MEPS) The Household Component captures person-level spending across service categories, coverage types. The consolidated file contains one row per individual within each sampled household, other tables contain one record per event (like prescription fills, hospitalizations), per job, per insurance policy. A complex sample survey designed to generalize to the U.S. civilian non-institutionalized population. Released annually since 1996. Administered by the Agency for Healthcare Research and Quality. Please skim before you begin: MEPS HC-224 2020 Full Year Consolidated Data File Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # king dumpty's horsemen # ahrq stitches payors, bills, claims # fractured health system Download, Import, Preparation Define a function to download, unzip, and import each sas file: library(haven) meps_sas_import <- function( this_url ){ this_tf <- tempfile() download.file( this_url , this_tf , mode = 'wb' ) this_tbl <- read_sas( this_tf ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the consolidated file and the replicate weights file: meps_cons_df <- meps_sas_import( "https://meps.ahrq.gov/data_files/pufs/h224/h224v9.zip" ) meps_brr_df <- meps_sas_import( "https://meps.ahrq.gov/mepsweb/data_files/pufs/h036brr/h36brr20v9.zip" ) Merge the consolidated file with the replicate weights: meps_df <- merge( meps_cons_df , meps_brr_df ) stopifnot( nrow( meps_df ) == nrow( meps_cons_df ) ) meps_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # meps_fn <- file.path( path.expand( "~" ) , "MEPS" , "this_file.rds" ) # saveRDS( meps_df , file = meps_fn , compress = FALSE ) Load the same object: # meps_df <- readRDS( meps_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) meps_design <- svrepdesign( data = meps_df , weights = ~ perwt20f , type = "BRR" , combined.weights = FALSE , repweights = "brr[1-9]+" , mse = TRUE ) Variable Recoding Add new columns to the data set: meps_design <- update( meps_design , one = 1 , insured_december_31st = ifelse( ins20x %in% 1:2 , as.numeric( ins20x == 1 ) , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( meps_design , "sampling" ) != 0 ) svyby( ~ one , ~ region20 , meps_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , meps_design ) svyby( ~ one , ~ region20 , meps_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ totexp20 , meps_design ) svyby( ~ totexp20 , ~ region20 , meps_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ sex , meps_design ) svyby( ~ sex , ~ region20 , meps_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ totexp20 , meps_design ) svyby( ~ totexp20 , ~ region20 , meps_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ sex , meps_design ) svyby( ~ sex , ~ region20 , meps_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ totexp20 , meps_design , 0.5 ) svyby( ~ totexp20 , ~ region20 , meps_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ totmcd20 , denominator = ~ totexp20 , meps_design ) Subsetting Restrict the survey design to seniors: sub_meps_design <- subset( meps_design , agelast >= 65 ) Calculate the mean (average) of this subset: svymean( ~ totexp20 , sub_meps_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ totexp20 , meps_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ totexp20 , ~ region20 , meps_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( meps_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ totexp20 , meps_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ totexp20 , meps_design , deff = TRUE ) # SRS with replacement svymean( ~ totexp20 , meps_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ insured_december_31st , meps_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( totexp20 ~ insured_december_31st , meps_design ) Perform a chi-squared test of association for survey data: svychisq( ~ insured_december_31st + sex , meps_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( totexp20 ~ insured_december_31st + sex , meps_design ) summary( glm_result ) Replication Example This example matches the statistic and standard error shown under Analysis of the Total Population: library(foreign) xport_2002_tf <- tempfile() xport_2002_url <- "https://meps.ahrq.gov/data_files/pufs/h70ssp.zip" download.file( xport_2002_url , xport_2002_tf , mode = 'wb' ) unzipped_2002_xport <- unzip( xport_2002_tf , exdir = tempdir() ) meps_2002_df <- read.xport( unzipped_2002_xport ) names( meps_2002_df ) <- tolower( names( meps_2002_df ) ) meps_2002_design <- svydesign( ~ varpsu , strata = ~ varstr , weights = ~ perwt02f , data = meps_2002_df , nest = TRUE ) result <- svymean( ~ totexp02 , meps_2002_design ) stopifnot( round( coef( result ) , 2 ) == 2813.24 ) stopifnot( round( SE( result ) , 2 ) == 58.99 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for MEPS users, this code replicates previously-presented examples: library(srvyr) meps_srvyr_design <- as_survey( meps_design ) Calculate the mean (average) of a linear variable, overall and by groups: meps_srvyr_design %>% summarize( mean = survey_mean( totexp20 ) ) meps_srvyr_design %>% group_by( region20 ) %>% summarize( mean = survey_mean( totexp20 ) ) "],["medical-large-claims-experience-study-mlces.html", "Medical Large Claims Experience Study (MLCES) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Medical Large Claims Experience Study (MLCES) A high quality dataset of medical claims from seven private health insurance companies. One table with one row per individual with nonzero total paid charges. A convenience sample of group (employer-sponsored) health insurers in the United States. 1997 thru 1999 with no expected updates in the future. Provided by the Society of Actuaries (SOA). Please skim before you begin: Group Medical Insurance Claims Database Collection and Analysis Report Claim Severities, Claim Relativities, and Age: Evidence from SOA Group Health Data This human-composed haiku or a bouquet of artificial intelligence-generated limericks # skewed by black swan tails # means, medians sing adieu # claims distribution Download, Import, Preparation Download and import the 1999 medical claims file: tf <- tempfile() this_url <- "https://www.soa.org/Files/Research/1999.zip" download.file( this_url , tf , mode = 'wb' ) unzipped_file <- unzip( tf , exdir = tempdir() ) mlces_df <- read.csv( unzipped_file ) names( mlces_df ) <- tolower( names( mlces_df ) ) Save locally   Save the object at any point: # mlces_fn <- file.path( path.expand( "~" ) , "MLCES" , "this_file.rds" ) # saveRDS( mlces_df , file = mlces_fn , compress = FALSE ) Load the same object: # mlces_df <- readRDS( mlces_fn ) Variable Recoding Add new columns to the data set: mlces_df <- transform( mlces_df , one = 1 , claimant_relationship_to_policyholder = ifelse( relation == "E" , "covered employee" , ifelse( relation == "S" , "spouse of covered employee" , ifelse( relation == "D" , "dependent of covered employee" , NA ) ) ) , ppo_plan = as.numeric( ppo == 'Y' ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( mlces_df ) table( mlces_df[ , "claimant_relationship_to_policyholder" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( mlces_df[ , "totpdchg" ] ) tapply( mlces_df[ , "totpdchg" ] , mlces_df[ , "claimant_relationship_to_policyholder" ] , mean ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( mlces_df[ , "patsex" ] ) ) prop.table( table( mlces_df[ , c( "patsex" , "claimant_relationship_to_policyholder" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( mlces_df[ , "totpdchg" ] ) tapply( mlces_df[ , "totpdchg" ] , mlces_df[ , "claimant_relationship_to_policyholder" ] , sum ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( mlces_df[ , "totpdchg" ] , 0.5 ) tapply( mlces_df[ , "totpdchg" ] , mlces_df[ , "claimant_relationship_to_policyholder" ] , quantile , 0.5 ) Subsetting Limit your data.frame to persons under 18: sub_mlces_df <- subset( mlces_df , ( ( claimyr - patbrtyr ) < 18 ) ) Calculate the mean (average) of this subset: mean( sub_mlces_df[ , "totpdchg" ] ) Measures of Uncertainty Calculate the variance, overall and by groups: var( mlces_df[ , "totpdchg" ] ) tapply( mlces_df[ , "totpdchg" ] , mlces_df[ , "claimant_relationship_to_policyholder" ] , var ) Regression Models and Tests of Association Perform a t-test: t.test( totpdchg ~ ppo_plan , mlces_df ) Perform a chi-squared test of association: this_table <- table( mlces_df[ , c( "ppo_plan" , "patsex" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( totpdchg ~ ppo_plan + patsex , data = mlces_df ) summary( glm_result ) Replication Example This example matches statistics in Table II-A’s 1999 row numbers 52 and 53 from the Database: Match Claimants Exceeding Deductible: # $0 deductible stopifnot( nrow( mlces_df ) == 1591738 ) # $1,000 deductible mlces_above_1000_df <- subset( mlces_df , totpdchg > 1000 ) stopifnot( nrow( mlces_above_1000_df ) == 402550 ) Match the Excess Charges Above Deductible: # $0 deductible stopifnot( round( sum( mlces_df[ , 'totpdchg' ] ) , 0 ) == 2599356658 ) # $1,000 deductible stopifnot( round( sum( mlces_above_1000_df[ , 'totpdchg' ] - 1000 ) , 0 ) == 1883768786 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for MLCES users, this code replicates previously-presented examples: library(dplyr) mlces_tbl <- as_tibble( mlces_df ) Calculate the mean (average) of a linear variable, overall and by groups: mlces_tbl %>% summarize( mean = mean( totpdchg ) ) mlces_tbl %>% group_by( claimant_relationship_to_policyholder ) %>% summarize( mean = mean( totpdchg ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for MLCES users, this code replicates previously-presented examples: library(data.table) mlces_dt <- data.table( mlces_df ) Calculate the mean (average) of a linear variable, overall and by groups: mlces_dt[ , mean( totpdchg ) ] mlces_dt[ , mean( totpdchg ) , by = claimant_relationship_to_policyholder ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for MLCES users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'mlces' , mlces_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( totpdchg ) FROM mlces' ) dbGetQuery( con , 'SELECT claimant_relationship_to_policyholder , AVG( totpdchg ) FROM mlces GROUP BY claimant_relationship_to_policyholder' ) "],["national-beneficiary-survey-nbs.html", "National Beneficiary Survey (NBS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Beneficiary Survey (NBS) The principal microdata for U.S. disability researchers interested in Social Security program performance. One table with one row per respondent. A complex sample designed to generalize to Americans between age 18 and full retirement age, covered by either Social Security Disability Insurance (SSDI) or Supplemental Security Income (SSI). Released at irregular intervals, with 2004, 2005, 2006, 2010, 2015, 2017, and 2019 available. Administered by the Social Security Administration. Please skim before you begin: National Beneficiary Survey: Disability Statistics, 2015 National Beneficiary Survey - General Waves Round 7: User’s Guide This human-composed haiku or a bouquet of artificial intelligence-generated limericks # social safety net # poverty acrobatics # trap or trampoline Download, Import, Preparation Download and import the round 7 file: library(haven) zip_tf <- tempfile() zip_url <- "https://www.ssa.gov/disabilityresearch/documents/R7NBSPUF_STATA.zip" download.file( zip_url , zip_tf , mode = 'wb' ) nbs_tbl <- read_stata( zip_tf ) nbs_df <- data.frame( nbs_tbl ) names( nbs_df ) <- tolower( names( nbs_df ) ) nbs_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # nbs_fn <- file.path( path.expand( "~" ) , "NBS" , "this_file.rds" ) # saveRDS( nbs_df , file = nbs_fn , compress = FALSE ) Load the same object: # nbs_df <- readRDS( nbs_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) # representative beneficiary sample nbs_design <- svydesign( id = ~ r7_a_psu_pub , strata = ~ r7_a_strata , weights = ~ r7_wtr7_ben , data = subset( nbs_df , r7_wtr7_ben > 0 ) ) # cross-sectional successful worker sample nbs_design <- svydesign( id = ~ r7_a_psu_pub , strata = ~ r7_a_strata , weights = ~ r7_wtr7_cssws , data = subset( nbs_df , r7_wtr7_cssws > 0 ) ) # longitudinal successful worker sample lngsws_design <- svydesign( id = ~ r7_a_psu_pub , strata = ~ r7_a_strata , weights = ~ r7_wtr7_lngsws , data = subset( nbs_df , r7_wtr7_lngsws > 0 ) ) Variable Recoding Add new columns to the data set: nbs_design <- update( nbs_design , male = as.numeric( r7_orgsampinfo_sex == 1 ) , age_categories = factor( r7_c_intage_pub , labels = c( "18-25" , "26-40" , "41-55" , "56 and older" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nbs_design , "sampling" ) != 0 ) svyby( ~ one , ~ age_categories , nbs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nbs_design ) svyby( ~ one , ~ age_categories , nbs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) svyby( ~ r7_n_totssbenlastmnth_pub , ~ age_categories , nbs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ r7_c_hhsize_pub , nbs_design , na.rm = TRUE ) svyby( ~ r7_c_hhsize_pub , ~ age_categories , nbs_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) svyby( ~ r7_n_totssbenlastmnth_pub , ~ age_categories , nbs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ r7_c_hhsize_pub , nbs_design , na.rm = TRUE ) svyby( ~ r7_c_hhsize_pub , ~ age_categories , nbs_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ r7_n_totssbenlastmnth_pub , nbs_design , 0.5 , na.rm = TRUE ) svyby( ~ r7_n_totssbenlastmnth_pub , ~ age_categories , nbs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ r7_n_ssilastmnth_pub , denominator = ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) Subsetting Restrict the survey design to currently covered by Medicare: sub_nbs_design <- subset( nbs_design , r7_c_curmedicare == 1 ) Calculate the mean (average) of this subset: svymean( ~ r7_n_totssbenlastmnth_pub , sub_nbs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ r7_n_totssbenlastmnth_pub , ~ age_categories , nbs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nbs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ r7_n_totssbenlastmnth_pub , nbs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ male , nbs_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( r7_n_totssbenlastmnth_pub ~ male , nbs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ male + r7_c_hhsize_pub , nbs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( r7_n_totssbenlastmnth_pub ~ male + r7_c_hhsize_pub , nbs_design ) summary( glm_result ) Replication Example This example matches the percentages and t-tests from the final ten rows of Exhibit 4: ex_4 <- data.frame( variable_label = c( 'coping with stress' , 'concentrating' , 'getting around outside of the home' , 'shopping for personal items' , 'preparing meals' , 'getting into or out of bed' , 'bathing or dressing' , 'getting along with others' , 'getting around inside the house' , 'eating' ) , variable_name = c( "r3_i60_i" , "r3_i59_i" , "r3_i47_i" , "r3_i53_i" , "r3_i55_i" , "r3_i49_i" , "r3_i51_i" , "r3_i61_i" , "r3_i45_i" , "r3_i57_i" ) , overall = c( 61 , 58 , 47 , 39 , 37 , 34 , 30 , 27 , 23 , 14 ) , di_only = c( 60 , 54 , 47 , 36 , 35 , 36 , 30 , 23 , 24 , 13 ) , concurrent = c( 63 , 63 , 47 , 43 , 41 , 34 , 33 , 31 , 23 , 15 ) , concurrent_vs_di = c( F , T , F , F , F , F , F , T , F , F ) , ssi = c( 61 , 62 , 47 , 40 , 39 , 33 , 29 , 31 , 22 , 15 ) , ssi_vs_di = c( F , T , F , F , F , F , F , T , F , F ) ) Download, import, and recode the round 3 file: r3_tf <- tempfile() r3_url <- "https://www.ssa.gov/disabilityresearch/documents/nbsr3pufstata.zip" download.file( r3_url , r3_tf , mode = 'wb' ) r3_tbl <- read_stata( r3_tf ) r3_df <- data.frame( r3_tbl ) names( r3_df ) <- tolower( names( r3_df ) ) r3_design <- svydesign( id = ~ r3_a_psu_pub , strata = ~ r3_a_strata , weights = ~ r3_wtr3_ben , data = subset( r3_df , r3_wtr3_ben > 0 ) ) r3_design <- update( r3_design , benefit_type = factor( r3_orgsampinfo_bstatus , levels = c( 2 , 3 , 1 ) , labels = c( 'di_only' , 'concurrent' , 'ssi' ) ) ) Calculate the final ten rows of exhibit 4 and confirm each statistics and t-test matches: for( i in seq( nrow( ex_4 ) ) ){ this_formula <- as.formula( paste( "~" , ex_4[ i , 'variable_name' ] ) ) overall_percent <- svymean( this_formula , r3_design ) stopifnot( 100 * round( coef( overall_percent ) , 2 ) == ex_4[ i , 'overall_percent' ] ) benefit_percent <- svyby( this_formula , ~ benefit_type , r3_design , svymean ) stopifnot( all.equal( 100 * as.numeric( round( coef( benefit_percent ) , 2 ) ) , as.numeric( ex_4[ i , c( 'di_only' , 'concurrent' , 'ssi' ) ] ) ) ) ttest_formula <- as.formula( paste( ex_4[ i , 'variable_name' ] , "~ benefit_type" ) ) di_only_con_design <- subset( r3_design , benefit_type %in% c( 'di_only' , 'concurrent' ) ) con_ttest <- svyttest( ttest_formula , di_only_con_design ) stopifnot( all.equal( as.logical( con_ttest$p.value < 0.05 ) , as.logical( ex_4[ i , 'concurrent_vs_di' ] ) ) ) di_only_ssi_design <- subset( r3_design , benefit_type %in% c( 'di_only' , 'ssi' ) ) ssi_ttest <- svyttest( ttest_formula , di_only_ssi_design ) stopifnot( all.equal( as.logical( ssi_ttest$p.value < 0.05 ) , as.logical( ex_4[ i , 'ssi_vs_di' ] ) ) ) } Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NBS users, this code replicates previously-presented examples: library(srvyr) nbs_srvyr_design <- as_survey( nbs_design ) Calculate the mean (average) of a linear variable, overall and by groups: nbs_srvyr_design %>% summarize( mean = survey_mean( r7_n_totssbenlastmnth_pub , na.rm = TRUE ) ) nbs_srvyr_design %>% group_by( age_categories ) %>% summarize( mean = survey_mean( r7_n_totssbenlastmnth_pub , na.rm = TRUE ) ) "],["national-financial-capability-study-nfcs.html", "National Financial Capability Study (NFCS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Financial Capability Study (NFCS) A study of financial knowledge and behavior, like making ends meet, planning ahead, managing assets. One state-by-state survey table with one row per sampled respondent, a separate investor survey. An online non-probability sample of U.S. adults (18+) calibrated to the American Community Survey. Released triennially since 2009. Funded by the FINRA Investor Education Foundation and conducted by FGS Global. Please skim before you begin: 2021 National Financial Capability Study: State-by-State Survey Methodology Financial Capability Insights: What the NFCS Reveals This human-composed haiku or a bouquet of artificial intelligence-generated limericks # lady madonna # laid bank balance goose egg, loves # gold unrequited Download, Import, Preparation Download and import the latest state-by-state microdata: library(haven) zip_tf <- tempfile() zip_url <- 'https://finrafoundation.org/sites/finrafoundation/files/2021-SxS-Data-and-Data-Info.zip' download.file( zip_url , zip_tf , mode = 'wb' ) unzipped_files <- unzip( zip_tf , exdir = tempdir() ) stata_fn <- grep( "\\\\.dta$" , unzipped_files , value = TRUE ) nfcs_tbl <- read_dta( stata_fn ) nfcs_df <- data.frame( nfcs_tbl ) names( nfcs_df ) <- tolower( names( nfcs_df ) ) Add a column of all ones, add labels to state names, add labels to the rainy day fund question: nfcs_df[ , 'one' ] <- 1 nfcs_df[ , 'state_name' ] <- factor( nfcs_df[ , 'stateq' ] , levels = 1:51 , labels = sort( c( 'District of Columbia' , state.name ) ) ) nfcs_df[ , 'rainy_day_fund' ] <- factor( nfcs_df[ , 'j5' ] , levels = c( 1 , 2 , 98 , 99 ) , labels = c( 'Yes' , 'No' , "Don't Know" , "Prefer not to say" ) ) Save locally   Save the object at any point: # nfcs_fn <- file.path( path.expand( "~" ) , "NFCS" , "this_file.rds" ) # saveRDS( nfcs_df , file = nfcs_fn , compress = FALSE ) Load the same object: # nfcs_df <- readRDS( nfcs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) nfcs_design <- svydesign( ~ 1 , data = nfcs_df , weights = ~ wgt_n2 ) divison_design <- svydesign( ~ 1 , data = nfcs_df , weights = ~ wgt_d2 ) state_design <- svydesign( ~ 1 , data = nfcs_df , weights = ~ wgt_s3 ) Variable Recoding Add new columns to the data set: nfcs_design <- update( nfcs_design , satisfaction_w_finances = ifelse( j1 > 10 , NA , j1 ) , risk_taking = ifelse( j2 > 10 , NA , j2 ) , difficult_to_pay_bills = factor( j4 , levels = c( 1 , 2 , 3 , 98 , 99 ) , labels = c( 'Very difficult' , 'Somewhat difficult' , 'Not at all difficult' , "Don't know" , 'Prefer not to say' ) ) , spending_vs_income = factor( j3 , levels = c( 1 , 2 , 3 , 98 , 99 ) , labels = c( 'Spending less than income' , 'Spending more than income' , 'Spending about equal to income' , "Don't know" , 'Prefer not to say' ) ) , unpaid_medical_bills = ifelse( g20 > 2 , NA , as.numeric( g20 == 1 ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nfcs_design , "sampling" ) != 0 ) svyby( ~ one , ~ spending_vs_income , nfcs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nfcs_design ) svyby( ~ one , ~ spending_vs_income , nfcs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE ) svyby( ~ satisfaction_w_finances , ~ spending_vs_income , nfcs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ difficult_to_pay_bills , nfcs_design ) svyby( ~ difficult_to_pay_bills , ~ spending_vs_income , nfcs_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE ) svyby( ~ satisfaction_w_finances , ~ spending_vs_income , nfcs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ difficult_to_pay_bills , nfcs_design ) svyby( ~ difficult_to_pay_bills , ~ spending_vs_income , nfcs_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ satisfaction_w_finances , nfcs_design , 0.5 , na.rm = TRUE ) svyby( ~ satisfaction_w_finances , ~ spending_vs_income , nfcs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ satisfaction_w_finances , denominator = ~ risk_taking , nfcs_design , na.rm = TRUE ) Subsetting Restrict the survey design to persons receiving pandemic-related stimulus payment: sub_nfcs_design <- subset( nfcs_design , j50 == 1 ) Calculate the mean (average) of this subset: svymean( ~ satisfaction_w_finances , sub_nfcs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ satisfaction_w_finances , ~ spending_vs_income , nfcs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nfcs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ satisfaction_w_finances , nfcs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ unpaid_medical_bills , nfcs_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( satisfaction_w_finances ~ unpaid_medical_bills , nfcs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ unpaid_medical_bills + difficult_to_pay_bills , nfcs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( satisfaction_w_finances ~ unpaid_medical_bills + difficult_to_pay_bills , nfcs_design ) summary( glm_result ) Replication Example This example matches the unweighted count shown on PDF page 4: stopifnot( nrow( nfcs_df ) == 27118 ) This example matches the PDF page 7 estimate that 53% have three months of rainy day funds: national_rainy_day <- svymean( ~ rainy_day_fund , nfcs_design ) stopifnot( round( coef( national_rainy_day )[ 'rainy_day_fundYes' ] , 2 ) == 0.53 ) This example matches counts and rainy day estimates from The Geography of Financial Capability: state_counts <- svyby( ~ one , ~ state_name , state_design , unwtd.count ) stopifnot( state_counts[ 'California' , 'counts' ] == 1252 ) stopifnot( state_counts[ 'Missouri' , 'counts' ] == 501 ) stopifnot( state_counts[ 'Oregon' , 'counts' ] == 1261 ) state_rainy_day <- svyby( ~ rainy_day_fund , ~ state_name , state_design , svymean ) stopifnot( round( state_rainy_day[ 'California' , 'rainy_day_fundYes' ] , 2 ) == 0.57 ) stopifnot( round( state_rainy_day[ 'Missouri' , 'rainy_day_fundYes' ] , 2 ) == 0.51 ) stopifnot( round( state_rainy_day[ 'Oregon' , 'rainy_day_fundYes' ] , 2 ) == 0.52 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NFCS users, this code replicates previously-presented examples: library(srvyr) nfcs_srvyr_design <- as_survey( nfcs_design ) Calculate the mean (average) of a linear variable, overall and by groups: nfcs_srvyr_design %>% summarize( mean = survey_mean( satisfaction_w_finances , na.rm = TRUE ) ) nfcs_srvyr_design %>% group_by( spending_vs_income ) %>% summarize( mean = survey_mean( satisfaction_w_finances , na.rm = TRUE ) ) "],["national-health-and-nutrition-examination-survey-nhanes.html", "National Health and Nutrition Examination Survey (NHANES) Download, Import, Preparation Analysis Examples with the survey library   Direct Method of Age-Adjustment Replication Example Analysis Examples with srvyr  ", " National Health and Nutrition Examination Survey (NHANES) Doctors and dentists accompany survey interviewers in a mobile medical center that travels the country. While survey researchers read the questionnaires, medical professionals administer laboratory tests and conduct a full medical examination. The blood work and in-person check-up allow epidemiologists to answer questions like, “how many people have diabetes but don’t know they have diabetes?” Many tables containing information from the various examinations, generally one row per respondent. A complex sample survey designed to generalize to the civilian non-institutionalized U.S. population. Released biennially since 1999-2000. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: About the National Health and Nutrition Examination Survey NHANES Tutorials This human-composed haiku or a bouquet of artificial intelligence-generated limericks # doctor, dentist, labs # mobile examination #vanlife interviews Download, Import, Preparation Download and import the demographics (demo) and total cholesterol laboratory (tchol) data: library(haven) nhanes_2015_2016_demo_url <- "https://wwwn.cdc.gov/Nchs/Nhanes/2015-2016/DEMO_I.XPT" nhanes_2017_2018_demo_url <- "https://wwwn.cdc.gov/Nchs/Nhanes/2017-2018/DEMO_J.XPT" nhanes_2015_2016_tchol_url <- "https://wwwn.cdc.gov/Nchs/Nhanes/2015-2016/TCHOL_I.XPT" nhanes_2017_2018_tchol_url <- "https://wwwn.cdc.gov/Nchs/Nhanes/2017-2018/TCHOL_J.XPT" nhanes_2015_2016_demo_tbl <- read_xpt( nhanes_2015_2016_demo_url ) nhanes_2017_2018_demo_tbl <- read_xpt( nhanes_2017_2018_demo_url ) nhanes_2015_2016_tchol_tbl <- read_xpt( nhanes_2015_2016_tchol_url ) nhanes_2017_2018_tchol_tbl <- read_xpt( nhanes_2017_2018_tchol_url ) nhanes_2015_2016_demo_df <- data.frame( nhanes_2015_2016_demo_tbl ) nhanes_2017_2018_demo_df <- data.frame( nhanes_2017_2018_demo_tbl ) nhanes_2015_2016_tchol_df <- data.frame( nhanes_2015_2016_tchol_tbl ) nhanes_2017_2018_tchol_df <- data.frame( nhanes_2017_2018_tchol_tbl ) Specify which variables to keep from both the demo and tchol data files, then stack the four years: demo_vars <- c( # unique person identifier (merge variable) "SEQN" , # the two-year interviewed + MEC examined weight "WTMEC2YR" , # note that this is a special weight for only # individuals who took the mobile examination center (MEC) exam # there is one other weight available - WTINT2YR - # that should be used when MEC variables are not part of the analysis # interviewed only or interviewed + MEC "RIDSTATR" , # primary sampling unit varaible, used in complex design "SDMVPSU" , # strata variable, used in complex design "SDMVSTRA" , # race / ethnicity "RIDRETH3" , # age "RIDAGEYR" , # gender "RIAGENDR" , # pregnant at interview "RIDEXPRG" ) nhanes_2015_2018_demo_df <- rbind( nhanes_2015_2016_demo_df[ , demo_vars ] , nhanes_2017_2018_demo_df[ , demo_vars ] ) tchol_vars <- c( # unique person identifier (merge variable) "SEQN" , # laboratory total cholesterol variable # https://wwwn.cdc.gov/Nchs/Nhanes/2017-2018/TCHOL_J.htm "LBXTC" ) nhanes_2015_2018_tchol_df <- rbind( nhanes_2015_2016_tchol_df[ , tchol_vars ] , nhanes_2017_2018_tchol_df[ , tchol_vars ] ) Merge the two pooled datasets, limit the data.frame to mobile examination component respondents: nhanes_full_df <- merge( nhanes_2015_2018_demo_df , nhanes_2015_2018_tchol_df , all = TRUE ) names( nhanes_full_df ) <- tolower( names( nhanes_full_df ) ) nhanes_df <- subset( nhanes_full_df , ridstatr %in% 2 ) Scale the mobile examination component two-year weight to generalize to the pooled, four year period: nhanes_df[ , 'wtmec4yr' ] <- nhanes_df[ , 'wtmec2yr' ] / 2 Save locally   Save the object at any point: # nhanes_fn <- file.path( path.expand( "~" ) , "NHANES" , "this_file.rds" ) # saveRDS( nhanes_df , file = nhanes_fn , compress = FALSE ) Load the same object: # nhanes_df <- readRDS( nhanes_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) nhanes_design <- svydesign( id = ~ sdmvpsu , strata = ~ sdmvstra , nest = TRUE , weights = ~ wtmec4yr , data = nhanes_df ) Variable Recoding Add new columns to the data set: nhanes_design <- update( nhanes_design , one = 1 , # define high total cholesterol as 1 if mg/dL is at or above 240 and zero otherwise. hi_tchol = ifelse( lbxtc >= 240 , 1 , 0 ) , gender = factor( riagendr , levels = 1:2 , labels = c( 'male' , 'female' ) ) , age_categories = factor( 1 + findInterval( ridageyr , c( 20 , 40 , 60 ) ) , levels = 1:4 , labels = c( "0-19" , "20-39" , "40-59" , "60+" ) ) , # recode the ridreth3 variable as: # mexican american and other hispanic -> 4 # non-hispanic white -> 1 # non-hispanic black -> 2 # non-hispanic asian -> 3 # other race including multi-racial -> 5 race_ethnicity = factor( c( 4 , 4 , 1 , 2 , NA , 3 , 5 )[ ridreth3 ] , levels = 1:5 , labels = c( 'nh white' , 'nh black' , 'nh asian' , 'hispanic' , 'other' ) ) , pregnant_at_interview = ifelse( ridexprg %in% 1:2 , as.numeric( ridexprg == 1 ) , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nhanes_design , "sampling" ) != 0 ) svyby( ~ one , ~ race_ethnicity , nhanes_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nhanes_design ) svyby( ~ one , ~ race_ethnicity , nhanes_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ lbxtc , nhanes_design , na.rm = TRUE ) svyby( ~ lbxtc , ~ race_ethnicity , nhanes_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ riagendr , nhanes_design ) svyby( ~ riagendr , ~ race_ethnicity , nhanes_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ lbxtc , nhanes_design , na.rm = TRUE ) svyby( ~ lbxtc , ~ race_ethnicity , nhanes_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ riagendr , nhanes_design ) svyby( ~ riagendr , ~ race_ethnicity , nhanes_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ lbxtc , nhanes_design , 0.5 , na.rm = TRUE ) svyby( ~ lbxtc , ~ race_ethnicity , nhanes_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ lbxtc , denominator = ~ ridageyr , nhanes_design , na.rm = TRUE ) Subsetting Restrict the survey design to respondents aged 60 or older: sub_nhanes_design <- subset( nhanes_design , age_categories == "60+" ) Calculate the mean (average) of this subset: svymean( ~ lbxtc , sub_nhanes_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ lbxtc , nhanes_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ lbxtc , ~ race_ethnicity , nhanes_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nhanes_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ lbxtc , nhanes_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ lbxtc , nhanes_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ lbxtc , nhanes_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ pregnant_at_interview , nhanes_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( lbxtc ~ pregnant_at_interview , nhanes_design ) Perform a chi-squared test of association for survey data: svychisq( ~ pregnant_at_interview + riagendr , nhanes_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( lbxtc ~ pregnant_at_interview + riagendr , nhanes_design ) summary( glm_result ) Direct Method of Age-Adjustment Replication Example This example matches the total cholesterol statistics and standard errors in Table 1 from Data Brief 363: Match the crude estimates in the footnote and also in the unadjusted age categories: crude_overall <- svymean( ~ hi_tchol , subset( nhanes_design , ridageyr >= 20 ) , na.rm = TRUE ) stopifnot( round( coef( crude_overall ) , 3 ) == 0.115 ) crude_by_gender <- svyby( ~ hi_tchol , ~ gender , subset( nhanes_design , ridageyr >= 20 ) , svymean , na.rm = TRUE ) stopifnot( round( coef( crude_by_gender )[ 1 ] , 3 ) == 0.103 ) stopifnot( round( coef( crude_by_gender )[ 2 ] , 3 ) == 0.126 ) crude_by_age <- svyby( ~ hi_tchol , ~ age_categories , subset( nhanes_design , ridageyr >= 20 ) , svymean , na.rm = TRUE ) stopifnot( round( coef( crude_by_age )[ 1 ] , 3 ) == 0.075 ) stopifnot( round( coef( crude_by_age )[ 2 ] , 3 ) == 0.157 ) stopifnot( round( coef( crude_by_age )[ 3 ] , 3 ) == 0.114 ) stopifnot( round( SE( crude_by_age )[ 1 ] , 3 ) == 0.005 ) stopifnot( round( SE( crude_by_age )[ 2 ] , 3 ) == 0.011 ) stopifnot( round( SE( crude_by_age )[ 3 ] , 3 ) == 0.008 ) Sum up 2000 Census totals based on the age groupings specified in footnote: pop_by_age <- data.frame( age_categories = c( "0-19" , "20-39" , "40-59" , "60+" ) , Freq = c( 78782657 , 77670618 , 72816615 , 45363752 ) ) Create a design with the nationwide population stratified to the above census counts: nhanes_age_adjusted <- postStratify( subset( nhanes_design , !is.na( hi_tchol ) ) , ~ age_categories , pop_by_age ) Match the overall adjusted estimates: results_overall <- svymean( ~ hi_tchol , subset( nhanes_age_adjusted , ridageyr >= 20 ) , na.rm = TRUE ) stopifnot( round( coef( results_overall ) , 3 ) == 0.114 ) stopifnot( round( SE( results_overall ) , 3 ) == 0.006 ) Create a design stratified to census counts broken out by gender, then match those estimates: nhanes_by_gender <- svystandardize( nhanes_design , by = ~ age_categories , # stratification variable over = ~ gender , # break out variable population = pop_by_age , # data.frame containing census populations excluding.missing = ~ hi_tchol # analysis variable of interest ) results_by_gender <- svyby( ~ hi_tchol , ~ gender , subset( nhanes_by_gender , ridageyr >= 20 ) , svymean , na.rm=TRUE ) stopifnot( round( coef( results_by_gender )[ 1 ] , 3 ) == 0.105 ) stopifnot( round( coef( results_by_gender )[ 2 ] , 3 ) == 0.121 ) stopifnot( round( SE( results_by_gender )[ 1 ] , 3 ) == 0.007 ) stopifnot( round( SE( results_by_gender )[ 2 ] , 3 ) == 0.008 ) Create a design stratified to census counts broken out by race/ethnicity, then match those estimates: nhanes_by_race <- svystandardize( nhanes_design , by = ~ age_categories , # stratification variable over = ~ race_ethnicity , # break out variable population = pop_by_age , # data.frame containing census populations excluding.missing = ~ hi_tchol # analysis variable of interest ) results_by_race_ethnicity <- svyby( ~ hi_tchol , ~ race_ethnicity , design = subset( nhanes_by_race , ridageyr >= 20 ) , svymean , na.rm=TRUE ) stopifnot( round( coef( results_by_race_ethnicity )[ 1 ] , 3 ) == 0.117 ) stopifnot( round( coef( results_by_race_ethnicity )[ 2 ] , 3 ) == 0.100 ) stopifnot( round( coef( results_by_race_ethnicity )[ 3 ] , 3 ) == 0.116 ) stopifnot( round( coef( results_by_race_ethnicity )[ 4 ] , 3 ) == 0.109 ) stopifnot( round( SE( results_by_race_ethnicity )[ 1 ] , 3 ) == 0.007 ) stopifnot( round( SE( results_by_race_ethnicity )[ 2 ] , 3 ) == 0.009 ) stopifnot( round( SE( results_by_race_ethnicity )[ 3 ] , 3 ) == 0.011 ) stopifnot( round( SE( results_by_race_ethnicity )[ 4 ] , 3 ) == 0.009 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NHANES users, this code replicates previously-presented examples: library(srvyr) nhanes_srvyr_design <- as_survey( nhanes_design ) Calculate the mean (average) of a linear variable, overall and by groups: nhanes_srvyr_design %>% summarize( mean = survey_mean( lbxtc , na.rm = TRUE ) ) nhanes_srvyr_design %>% group_by( race_ethnicity ) %>% summarize( mean = survey_mean( lbxtc , na.rm = TRUE ) ) "],["national-health-interview-survey-nhis.html", "National Health Interview Survey (NHIS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " National Health Interview Survey (NHIS) America’s most detailed household survey of health status and medical experience. One table with one row per sampled adult (18+) within each sampled household, one table with one row per sample child (when available, same family not required), multiply-imputed income tables. A complex sample survey designed to generalize to the U.S. civilian non-institutionalized population. Released annually since 1963, the most recent major re-design in 2019. Conducted by the National Center for Health Statistics at the Centers for Disease Control. Please skim before you begin: 2021 Survey Description Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # excellent health poor # wealth. "sup, doc?" bugs, daft bills, free # laughs best medicine Download, Import, Preparation Define a function to download, unzip, and import each comma-separated value file: nhis_csv_import <- function( this_url ){ this_tf <- tempfile() download.file( this_url , this_tf , mode = 'wb' ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) this_csv <- grep( '\\\\.csv$' , unzipped_files , value = TRUE ) this_df <- read.csv( this_csv ) file.remove( c( this_tf , unzipped_files ) ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the sample adult interview and imputed income files: nhis_df <- nhis_csv_import( "https://ftp.cdc.gov/pub/Health_Statistics/NCHS/Datasets/NHIS/2021/adult21csv.zip" ) imputed_income_df <- nhis_csv_import( "https://ftp.cdc.gov/pub/Health_Statistics/NCHS/Datasets/NHIS/2021/adultinc21csv.zip" ) Save locally   Save the object at any point: # nhis_fn <- file.path( path.expand( "~" ) , "NHIS" , "this_file.rds" ) # saveRDS( nhis_df , file = nhis_fn , compress = FALSE ) Load the same object: # nhis_df <- readRDS( nhis_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: Reshape the imputed income data.frame into a list based on the implicate number: imputed_income_list <- split( imputed_income_df , imputed_income_df[ , 'impnum_a' ] ) Remove overlapping columns except the merge variable: variables_to_remove <- setdiff( intersect( names( nhis_df ) , names( imputed_income_df ) ) , 'hhx' ) nhis_df <- nhis_df[ , !( names( nhis_df ) %in% variables_to_remove ) ] Merge each implicate onto the sample adult table: nhis_list <- lapply( imputed_income_list , function( w ){ this_df <- merge( nhis_df , w ) stopifnot( nrow( this_df ) == nrow( nhis_df ) ) this_df } ) Define the design: library(survey) library(mitools) nhis_design <- svydesign( id = ~ ppsu , strata = ~ pstrat , nest = TRUE , weights = ~ wtfa_a , data = imputationList( nhis_list ) ) Variable Recoding Add new columns to the data set: nhis_design <- update( nhis_design , one = 1 , poverty_category = factor( findInterval( povrattc_a , c( 1 , 2 , 4 ) ) , labels = c( "below poverty" , "100-199%" , "200-399%" , "400%+" ) ) , fair_or_poor_reported_health = ifelse( phstat_a %in% 1:5 , as.numeric( phstat_a >= 4 ) , NA ) , sex_a = factor( sex_a , levels = 1:2 , labels = c( "male" , "female" ) ) , annual_premium_first_plan = ifelse( hicostr1_a > 40000 , NA , hicostr1_a ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: MIcombine( with( nhis_design , svyby( ~ one , ~ one , unwtd.count ) ) ) MIcombine( with( nhis_design , svyby( ~ one , ~ poverty_category , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: MIcombine( with( nhis_design , svytotal( ~ one ) ) ) MIcombine( with( nhis_design , svyby( ~ one , ~ poverty_category , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: MIcombine( with( nhis_design , svymean( ~ agep_a ) ) ) MIcombine( with( nhis_design , svyby( ~ agep_a , ~ poverty_category , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: MIcombine( with( nhis_design , svymean( ~ sex_a ) ) ) MIcombine( with( nhis_design , svyby( ~ sex_a , ~ poverty_category , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: MIcombine( with( nhis_design , svytotal( ~ agep_a ) ) ) MIcombine( with( nhis_design , svyby( ~ agep_a , ~ poverty_category , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: MIcombine( with( nhis_design , svytotal( ~ sex_a ) ) ) MIcombine( with( nhis_design , svyby( ~ sex_a , ~ poverty_category , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: MIcombine( with( nhis_design , svyquantile( ~ agep_a , 0.5 , se = TRUE ) ) ) MIcombine( with( nhis_design , svyby( ~ agep_a , ~ poverty_category , svyquantile , 0.5 , se = TRUE , ci = TRUE ) ) ) Estimate a ratio: MIcombine( with( nhis_design , svyratio( numerator = ~ annual_premium_first_plan , denominator = ~ agep_a , na.rm = TRUE ) ) ) Subsetting Restrict the survey design to uninsured: sub_nhis_design <- subset( nhis_design , notcov_a == 1 ) Calculate the mean (average) of this subset: MIcombine( with( sub_nhis_design , svymean( ~ agep_a ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- MIcombine( with( nhis_design , svymean( ~ agep_a ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- MIcombine( with( nhis_design , svyby( ~ agep_a , ~ poverty_category , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nhis_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: MIcombine( with( nhis_design , svyvar( ~ agep_a ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement MIcombine( with( nhis_design , svymean( ~ agep_a , deff = TRUE ) ) ) # SRS with replacement MIcombine( with( nhis_design , svymean( ~ agep_a , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ fair_or_poor_reported_health , nhis_design , # method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( agep_a ~ fair_or_poor_reported_health , nhis_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ fair_or_poor_reported_health + sex_a , nhis_design ) Perform a survey-weighted generalized linear model: glm_result <- MIcombine( with( nhis_design , svyglm( agep_a ~ fair_or_poor_reported_health + sex_a ) ) ) summary( glm_result ) Replication Example This example matches statistics and standard errors within 0.01% from Figure 3 of this Characteristics of Adults Aged 18–64 Who Did Not Take Medication as Prescribed to Reduce Costs Data Brief: results <- MIcombine( with( subset( nhis_design , agep_a < 65 ) , svyby( ~ as.numeric( rxsk12m_a == 1 | rxls12m_a == 1 | rxdl12m_a == 1 ) , ~ poverty_category , svymean , na.rm = TRUE ) ) ) stopifnot( all( as.numeric( round( coef( results ) , 3 ) ) == c( 0.145 , 0.138 , 0.099 , 0.039 ) ) ) stopifnot( all( as.numeric( round( SE( results ) , 5 ) ) - c( 0.0126 , 0.0098 , 0.0062 , 0.0031 ) < 0.0001 ) ) "],["national-household-travel-survey-nhts.html", "National Household Travel Survey (NHTS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Household Travel Survey (NHTS) The authoritative source on travel behavior, recording characteristics of people and vehicles of all modes. Four core linkable tables, with one record per household, person, trip, and vehicle, respectively. A complex sample survey designed to generalize to the civilian non-institutional U.S. population. Released every five to eight years since 1969, with a 2022 release expected in late 2023. Funded by the Federal Highway Administration, with data collected by Westat. Please skim before you begin: 2017 NHTS Data User Guide 2017 NHTS Weighting Report This human-composed haiku or a bouquet of artificial intelligence-generated limericks # commuter patterns, # truckin'. what a long strange trip # who went when where why Download, Import, Preparation Download and unzip each of the main 2017 files: library(haven) nhts_dl_uz <- function( this_url ){ tf <- tempfile() download.file( this_url , tf , mode = 'wb' ) unzip( tf , exdir = tempdir() ) } unzipped_survey_data <- nhts_dl_uz( "https://nhts.ornl.gov/assets/2016/download/sas.zip" ) unzipped_replicate_weights <- nhts_dl_uz( "https://nhts.ornl.gov/assets/2016/download/Replicates.zip" ) unzipped_trip_chains <- nhts_dl_uz( "https://nhts.ornl.gov/assets/2016/download/TripChain/TripChain17.zip" ) Import the tables containing one record per household, person, trip, and vehicle: nhts_import <- function( this_prefix , this_unzip ){ this_sas7bdat <- grep( paste0( this_prefix , "\\\\.sas7bdat$" ) , this_unzip , value = TRUE ) this_tbl <- read_sas( this_sas7bdat ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) this_df } hhpub_df <- nhts_import( "hhpub" , unzipped_survey_data ) perpub_df <- nhts_import( "perpub" , unzipped_survey_data ) trippub_df <- nhts_import( "trippub" , unzipped_survey_data ) vehpub_df <- nhts_import( "vehpub" , unzipped_survey_data ) hhwgt_df <- nhts_import( "hhwgt" , unzipped_replicate_weights ) perwgt_df <- nhts_import( "perwgt" , unzipped_replicate_weights ) Add a column of ones to three of those tables, then a column of non-missing mileage to the trips table: hhpub_df[ , 'one' ] <- 1 perpub_df[ , 'one' ] <- 1 trippub_df[ , 'one' ] <- 1 trippub_df[ !( trippub_df[ , 'trpmiles' ] %in% -9 ) , 'tripmiles_no_nines' ] <- trippub_df[ !( trippub_df[ , 'trpmiles' ] %in% -9 ) , 'trpmiles' ] Sum the total trip count and mileage to the person-level, both overall and restricted to walking only: trips_per_person <- with( trippub_df , aggregate( cbind( one , tripmiles_no_nines ) , list( houseid , personid ) , sum , na.rm = TRUE ) ) names( trips_per_person ) <- c( 'houseid' , 'personid' , 'trips_per_person' , 'miles_per_person' ) walks_per_person <- with( subset( trippub_df , trptrans == '01' ) , aggregate( cbind( one , tripmiles_no_nines ) , list( houseid , personid ) , sum , na.rm = TRUE ) ) names( walks_per_person ) <- c( 'houseid' , 'personid' , 'walks_per_person' , 'walk_miles_per_person' ) Merge these trip count and mileage values on to the person-level file, replacing non-matches with zero: nhts_df <- merge( perpub_df , trips_per_person , all.x = TRUE ) nhts_df[ is.na( nhts_df[ , 'trips_per_person' ] ) , 'trips_per_person' ] <- 0 nhts_df[ is.na( nhts_df[ , 'miles_per_person' ] ) , 'miles_per_person' ] <- 0 nhts_df <- merge( nhts_df , walks_per_person , all.x = TRUE ) nhts_df[ is.na( nhts_df[ , 'walks_per_person' ] ) , 'walks_per_person' ] <- 0 nhts_df[ is.na( nhts_df[ , 'walk_miles_per_person' ] ) , 'walk_miles_per_person' ] <- 0 stopifnot( nrow( nhts_df ) == nrow( perpub_df ) ) Save locally   Save the object at any point: # nhts_fn <- file.path( path.expand( "~" ) , "NHTS" , "this_file.rds" ) # saveRDS( nhts_df , file = nhts_fn , compress = FALSE ) Load the same object: # nhts_df <- readRDS( nhts_fn ) Survey Design Definition Construct a complex sample survey design: Sort both the one record per household and household replicate weights tables, then define the design: library(survey) hhpub_df <- hhpub_df[ order( hhpub_df[ , 'houseid' ] ) , ] hhwgt_df <- hhwgt_df[ order( hhwgt_df[ , 'houseid' ] ) , ] hh_design <- svrepdesign( weight = ~ wthhfin , repweights = hhwgt_df[ grep( 'wthhfin[0-9]' , names( hhwgt_df ) , value = TRUE ) ] , scale = 6 / 7 , rscales = 1 , type = 'JK1' , mse = TRUE , data = hhpub_df ) Sort both the one record per person and person replicate weights tables, then define the design: nhts_df <- nhts_df[ do.call( order , nhts_df[ , c( 'houseid' , 'personid' ) ] ) , ] perwgt_df <- perwgt_df[ do.call( order , perwgt_df[ , c( 'houseid' , 'personid' ) ] ) , ] nhts_design <- svrepdesign( weight = ~ wtperfin , repweights = perwgt_df[ grep( 'wtperfin[0-9]' , names( perwgt_df ) , value = TRUE ) ] , scale = 6 / 7 , rscales = rep( 1 , 98 ) , type = 'JK1' , mse = TRUE , data = nhts_df ) Sort both the one record per trip and person replicate weights tables, then define the design: trippub_df <- trippub_df[ do.call( order , trippub_df[ , c( 'houseid' , 'personid' ) ] ) , ] perwgt_df <- perwgt_df[ do.call( order , perwgt_df[ , c( 'houseid' , 'personid' ) ] ) , ] trip_design <- svrepdesign( weight = ~ wttrdfin , repweights = perwgt_df[ grep( 'wttrdfin[0-9]' , names( perwgt_df ) , value = TRUE ) ] , scale = 6 / 7 , rscales = 1 , type = 'JK1' , mse = TRUE , data = trippub_df ) Variable Recoding Add new columns to the data set: hh_design <- update( hh_design , hhsize_categories = factor( findInterval( hhsize , 1:4 ) , levels = 1:4 , labels = c( 1:3 , '4 or more' ) ) ) nhts_design <- update( nhts_design , urban_area = as.numeric( urbrur == '01' ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nhts_design , "sampling" ) != 0 ) svyby( ~ one , ~ r_sex_imp , nhts_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nhts_design ) svyby( ~ one , ~ r_sex_imp , nhts_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ miles_per_person , nhts_design ) svyby( ~ miles_per_person , ~ r_sex_imp , nhts_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ hhstate , nhts_design ) svyby( ~ hhstate , ~ r_sex_imp , nhts_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ miles_per_person , nhts_design ) svyby( ~ miles_per_person , ~ r_sex_imp , nhts_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ hhstate , nhts_design ) svyby( ~ hhstate , ~ r_sex_imp , nhts_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ miles_per_person , nhts_design , 0.5 ) svyby( ~ miles_per_person , ~ r_sex_imp , nhts_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ walk_miles_per_person , denominator = ~ miles_per_person , nhts_design ) Subsetting Restrict the survey design to ever cyclists: sub_nhts_design <- subset( nhts_design , nbiketrp > 0 ) Calculate the mean (average) of this subset: svymean( ~ miles_per_person , sub_nhts_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ miles_per_person , nhts_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ miles_per_person , ~ r_sex_imp , nhts_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nhts_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ miles_per_person , nhts_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ miles_per_person , nhts_design , deff = TRUE ) # SRS with replacement svymean( ~ miles_per_person , nhts_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ urban_area , nhts_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( miles_per_person ~ urban_area , nhts_design ) Perform a chi-squared test of association for survey data: svychisq( ~ urban_area + hhstate , nhts_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( miles_per_person ~ urban_area + hhstate , nhts_design ) summary( glm_result ) Replication Example This example matches the 2017 rows from Summary of Travel Trends Table 1a: hhsize_counts <- svytotal( ~ hhsize_categories , hh_design ) stopifnot( all( round( coef( hhsize_counts ) / 1000 , 0 ) == c( 32952 , 40056 , 18521 , 26679 ) ) ) hhsize_ci <- confint( hhsize_counts , df = ncol( hh_design$repweights ) ) hhsize_moe <- hhsize_ci[ , 2 ] - coef( hhsize_counts ) stopifnot( all( round( hhsize_moe / 1000 , 0 ) == c( 0 , 0 , 97 , 97 ) ) ) This example matches 2017 NHTS Westat project co-author’s workshop slide 38: unwtd_n <- with( nhts_df , tapply( trips_per_person , worker , sum ) ) stopifnot( all( unwtd_n == c( 79295 , 28 , 497944 , 346305 ) ) ) surveyed_n <- with( nhts_df , tapply( trips_per_person , worker , mean ) ) stopifnot( all( round( surveyed_n , 2 ) == c( 2.84 , 1.65 , 3.88 , 3.21 ) ) ) this_mean <- svyby( ~ trips_per_person , ~ worker , nhts_design , svymean ) stopifnot( round( coef( this_mean ) , 2 ) == c( 2.78 , 1.28 , 3.77 , 3.01 ) ) this_ci <- confint( this_mean , df = ncol( nhts_design$repweights ) ) this_moe <- this_ci[ , 2 ] - coef( this_mean ) stopifnot( all( round( this_moe , 2 ) == c( 0.06 , 2.21 , 0.03 , 0.06 ) ) ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NHTS users, this code replicates previously-presented examples: library(srvyr) nhts_srvyr_design <- as_survey( nhts_design ) Calculate the mean (average) of a linear variable, overall and by groups: nhts_srvyr_design %>% summarize( mean = survey_mean( miles_per_person ) ) nhts_srvyr_design %>% group_by( r_sex_imp ) %>% summarize( mean = survey_mean( miles_per_person ) ) "],["national-immunization-survey-nis.html", "National Immunization Survey (NIS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Immunization Survey (NIS) The vaccination coverage rate tracker for national, state, and selected local areas. One table with one row per sampled toddler. A complex sample survey designed to generalize to children aged 19-35 months in the United States. Released annually since 1995, plus an adolescent (13-17 years) sample since 2008. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: About NIS National Immunization Survey-Child: A User’s Guide for the 2021 Public-Use Data File This human-composed haiku or a bouquet of artificial intelligence-generated limericks # i hear babies cry # protesting lungs of iron # a wonderful world Download, Import, Preparation Download the fixed-width file: dat_tf <- tempfile() dat_url <- "https://ftp.cdc.gov/pub/Vaccines_NIS/NISPUF21.DAT" download.file( dat_url , dat_tf , mode = 'wb' ) Edit then execute the import script provided by the CDC: library(Hmisc) r_tf <- tempfile() r_script_url <- "https://ftp.cdc.gov/pub/Vaccines_NIS/NISPUF21.R" r_input_lines <- readLines( r_script_url ) # do not let the script do the save() r_input_lines <- gsub( "^save\\\\(" , "# save(" , r_input_lines ) # redirect the path to the flat file to the local save location of `dat_tf` r_input_lines <- gsub( '\\\\"path\\\\-to\\\\-file\\\\/(.*)\\\\.DAT\\\\"' , "dat_tf" , r_input_lines ) # save the edited script locally writeLines( r_input_lines , r_tf ) # run the edited script source( r_tf , echo = TRUE ) # rename the resultant data.frame object nis_df <- NISPUF21 names( nis_df ) <- tolower( names( nis_df ) ) nis_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # nis_fn <- file.path( path.expand( "~" ) , "NIS" , "this_file.rds" ) # saveRDS( nis_df , file = nis_fn , compress = FALSE ) Load the same object: # nis_df <- readRDS( nis_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) nis_design <- svydesign( id = ~ seqnumhh , strata = ~ stratum , weights = ~ provwt_c , data = subset( nis_df , provwt_c > 0 ) ) Variable Recoding Add new columns to the data set: nis_design <- update( nis_design , first_fed_formula = ifelse( bf_formr20 %in% 888 , NA , bf_formr20 ) , dtap_3p = as.numeric( ( p_numdah >= 3 ) | ( p_numdhi >= 3 ) | ( p_numdih >= 3 ) | ( p_numdta >= 3 ) | ( p_numdtp >= 3 ) ) , dtap_4p = as.numeric( ( p_numdah >= 4 ) | ( p_numdhi >= 4 ) | ( p_numdih >= 4 ) | ( p_numdta >= 4 ) | ( p_numdtp >= 4 ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nis_design , "sampling" ) != 0 ) svyby( ~ one , ~ state , nis_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nis_design ) svyby( ~ one , ~ state , nis_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ first_fed_formula , nis_design , na.rm = TRUE ) svyby( ~ first_fed_formula , ~ state , nis_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ sex , nis_design , na.rm = TRUE ) svyby( ~ sex , ~ state , nis_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ first_fed_formula , nis_design , na.rm = TRUE ) svyby( ~ first_fed_formula , ~ state , nis_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ sex , nis_design , na.rm = TRUE ) svyby( ~ sex , ~ state , nis_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ first_fed_formula , nis_design , 0.5 , na.rm = TRUE ) svyby( ~ first_fed_formula , ~ state , nis_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ bf_exclr06 , denominator = ~ bf_endr06 , nis_design , na.rm = TRUE ) Subsetting Restrict the survey design to toddlers up to date on polio shots: sub_nis_design <- subset( nis_design , p_utdpol == 1 ) Calculate the mean (average) of this subset: svymean( ~ first_fed_formula , sub_nis_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ first_fed_formula , nis_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ first_fed_formula , ~ state , nis_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nis_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ first_fed_formula , nis_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ first_fed_formula , nis_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ first_fed_formula , nis_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ dtap_3p , nis_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( first_fed_formula ~ dtap_3p , nis_design ) Perform a chi-squared test of association for survey data: svychisq( ~ dtap_3p + sex , nis_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( first_fed_formula ~ dtap_3p + sex , nis_design ) summary( glm_result ) Replication Example This example matches the statistics and standard errors from Data User’s Guide Table 4: results <- svyby( ~ p_utd431h314_rout_s , ~ raceethk , nis_design , svymean ) coefficients <- results[ , "p_utd431h314_rout_sUTD" , drop = FALSE ] standard_errors <- results[ , "se.p_utd431h314_rout_sUTD" , drop = FALSE ] stopifnot( round( coefficients[ "HISPANIC" , ] , 3 ) == .711 ) stopifnot( round( coefficients[ "NON-HISPANIC WHITE ONLY" , ] , 3 ) == .742 ) stopifnot( round( coefficients[ "NON-HISPANIC BLACK ONLY" , ] , 3 ) == .647 ) stopifnot( round( standard_errors[ "HISPANIC" , ] , 3 ) == .015 ) stopifnot( round( standard_errors[ "NON-HISPANIC WHITE ONLY" , ] , 3 ) == .009 ) stopifnot( round( standard_errors[ "NON-HISPANIC BLACK ONLY" , ] , 3 ) == .022 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NIS users, this code replicates previously-presented examples: library(srvyr) nis_srvyr_design <- as_survey( nis_design ) Calculate the mean (average) of a linear variable, overall and by groups: nis_srvyr_design %>% summarize( mean = survey_mean( first_fed_formula , na.rm = TRUE ) ) nis_srvyr_design %>% group_by( state ) %>% summarize( mean = survey_mean( first_fed_formula , na.rm = TRUE ) ) "],["national-plan-and-provider-enumeration-system-nppes.html", "National Plan and Provider Enumeration System (NPPES) Download, Import, Preparation Analysis Examples with base R   Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " National Plan and Provider Enumeration System (NPPES) The registry of every medical practitioner actively operating in the United States healthcare industry. A single large table with one row per enumerated health care provider. A census of individuals and organizations that bill for medical services in the United States. Updated weekly with new providers. Maintained by the United States Centers for Medicare & Medicaid Services (CMS) Please skim before you begin: NPI: What You Need To Know Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # how many doctors # ranked sergeant, last name pepper # practice in the states? Download, Import, Preparation Download and import the national file: library(readr) tf <- tempfile() npi_datapage <- readLines( "http://download.cms.gov/nppes/NPI_Files.html" ) latest_files <- grep( 'NPPES_Data_Dissemination_' , npi_datapage , value = TRUE ) latest_files <- latest_files[ !grepl( 'Weekly Update' , latest_files ) ] this_url <- paste0( "http://download.cms.gov/nppes/", gsub( "(.*)(NPPES_Data_Dissemination_.*\\\\.zip)(.*)$", "\\\\2", latest_files ) ) download.file( this_url , tf , mode = 'wb' ) npi_files <- unzip( tf , exdir = tempdir() ) npi_filepath <- grep( "npidata_pfile_20050523-([0-9]+)\\\\.csv" , npi_files , value = TRUE ) column_names <- names( read.csv( npi_filepath , nrow = 1 )[ FALSE , , ] ) column_names <- gsub( "\\\\." , "_" , tolower( column_names ) ) column_types <- ifelse( grepl( "code" , column_names ) & !grepl( "country|state|gender|taxonomy|postal" , column_names ) , 'n' , 'c' ) columns_to_import <- c( "entity_type_code" , "provider_gender_code" , "provider_enumeration_date" , "is_sole_proprietor" , "provider_business_practice_location_address_state_name" ) stopifnot( all( columns_to_import %in% column_names ) ) # readr::read_csv() columns must match their order in the csv file columns_to_import <- columns_to_import[ order( match( columns_to_import , column_names ) ) ] nppes_tbl <- readr::read_csv( npi_filepath , col_names = columns_to_import , col_types = paste0( ifelse( column_names %in% columns_to_import , column_types , '_' ) , collapse = "" ) , skip = 1 ) nppes_df <- data.frame( nppes_tbl ) Save locally   Save the object at any point: # nppes_fn <- file.path( path.expand( "~" ) , "NPPES" , "this_file.rds" ) # saveRDS( nppes_df , file = nppes_fn , compress = FALSE ) Load the same object: # nppes_df <- readRDS( nppes_fn ) Variable Recoding Add new columns to the data set: nppes_df <- transform( nppes_df , individual = as.numeric( entity_type_code ) , provider_enumeration_year = as.numeric( substr( provider_enumeration_date , 7 , 10 ) ) , state_name = provider_business_practice_location_address_state_name ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( nppes_df ) table( nppes_df[ , "provider_gender_code" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( nppes_df[ , "provider_enumeration_year" ] , na.rm = TRUE ) tapply( nppes_df[ , "provider_enumeration_year" ] , nppes_df[ , "provider_gender_code" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( nppes_df[ , "is_sole_proprietor" ] ) ) prop.table( table( nppes_df[ , c( "is_sole_proprietor" , "provider_gender_code" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( nppes_df[ , "provider_enumeration_year" ] , na.rm = TRUE ) tapply( nppes_df[ , "provider_enumeration_year" ] , nppes_df[ , "provider_gender_code" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( nppes_df[ , "provider_enumeration_year" ] , 0.5 , na.rm = TRUE ) tapply( nppes_df[ , "provider_enumeration_year" ] , nppes_df[ , "provider_gender_code" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to California: sub_nppes_df <- subset( nppes_df , state_name = 'CA' ) Calculate the mean (average) of this subset: mean( sub_nppes_df[ , "provider_enumeration_year" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( nppes_df[ , "provider_enumeration_year" ] , na.rm = TRUE ) tapply( nppes_df[ , "provider_enumeration_year" ] , nppes_df[ , "provider_gender_code" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( provider_enumeration_year ~ individual , nppes_df ) Perform a chi-squared test of association: this_table <- table( nppes_df[ , c( "individual" , "is_sole_proprietor" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( provider_enumeration_year ~ individual + is_sole_proprietor , data = nppes_df ) summary( glm_result ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for NPPES users, this code replicates previously-presented examples: library(dplyr) nppes_tbl <- as_tibble( nppes_df ) Calculate the mean (average) of a linear variable, overall and by groups: nppes_tbl %>% summarize( mean = mean( provider_enumeration_year , na.rm = TRUE ) ) nppes_tbl %>% group_by( provider_gender_code ) %>% summarize( mean = mean( provider_enumeration_year , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for NPPES users, this code replicates previously-presented examples: library(data.table) nppes_dt <- data.table( nppes_df ) Calculate the mean (average) of a linear variable, overall and by groups: nppes_dt[ , mean( provider_enumeration_year , na.rm = TRUE ) ] nppes_dt[ , mean( provider_enumeration_year , na.rm = TRUE ) , by = provider_gender_code ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for NPPES users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'nppes' , nppes_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( provider_enumeration_year ) FROM nppes' ) dbGetQuery( con , 'SELECT provider_gender_code , AVG( provider_enumeration_year ) FROM nppes GROUP BY provider_gender_code' ) "],["national-survey-of-childrens-health-nsch.html", "National Survey of Children’s Health (NSCH) Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " National Survey of Children’s Health (NSCH) Estimates of children’s health care and family environments to inform reports like Healthy People 2030. One screener table with one row per eligible child (1+ rows per household), one topical table with the sampled child (only one row per household) from three stacked age-specific questionnaires. A complex sample survey designed to generalize to non-institutionalized U.S. children under 18. Released every four or five years since 2003, annually since 2016. Sponsored by the Maternal and Child Health Bureau, Health Resources and Services Administration. Please skim before you begin: 2021 National Survey of Children’s Health Methodology Report 2021 National Survey of Children’s Health Data Users Frequently Asked Questions (FAQs) This human-composed haiku or a bouquet of artificial intelligence-generated limericks # "age but a number" # lied babe from crib. "your nose grows" # cried gramps changing bib Download, Import, Preparation Define a function to download, unzip, and import each comma-separated value file: library(haven) nsch_stata_import <- function( this_url ){ this_tf <- tempfile() download.file( this_url , this_tf , mode = 'wb' ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) this_stata <- grep( '\\\\.dta$' , unzipped_files , value = TRUE ) this_tbl <- read_stata( this_stata ) this_df <- data.frame( this_tbl ) file.remove( c( this_tf , unzipped_files ) ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the sample adult interview and imputed income files: nsch_screener_url <- "https://www2.census.gov/programs-surveys/nsch/datasets/2021/nsch_2021_screener_Stata.zip" nsch_topical_url <- "https://www2.census.gov/programs-surveys/nsch/datasets/2021/nsch_2021_topical_Stata.zip" nsch_screener_df <- nsch_stata_import( nsch_screener_url ) nsch_df <- nsch_stata_import( nsch_topical_url ) Save locally   Save the object at any point: # nsch_fn <- file.path( path.expand( "~" ) , "NSCH" , "this_file.rds" ) # saveRDS( nsch_df , file = nsch_fn , compress = FALSE ) Load the same object: # nsch_df <- readRDS( nsch_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: Remove the fpl columns from the main data.frame: fpl_columns <- grep( '^fpl_i[0-9]' , names( nsch_df ) , value = TRUE ) fpl_wide_df <- nsch_df[ c( 'hhid' , fpl_columns ) ] nsch_df[ fpl_columns ] <- NULL Reshape the fpl columns from wide to long: fpl_long_df <- reshape( fpl_wide_df , varying = list( fpl_columns ) , direction = 'long' , timevar = 'implicate' , idvar = 'hhid' ) names( fpl_long_df )[ ncol( fpl_long_df ) ] <- 'fpl' Merge the fpl table with multiple records per child onto the main table: nsch_long_df <- merge( nsch_df , fpl_long_df ) stopifnot( nrow( nsch_long_df ) == nrow( fpl_long_df ) ) stopifnot( nrow( nsch_long_df ) / length( fpl_columns ) == nrow( nsch_df ) ) Reshape the imputed income data.frame into a list based on the implicate number: nsch_list <- split( nsch_long_df , nsch_long_df[ , 'implicate' ] ) Define the design: library(survey) library(mitools) nsch_design <- svydesign( id = ~ 1 , strata = ~ fipsst + stratum , weights = ~ fwc , data = imputationList( nsch_list ) , nest = TRUE ) Variable Recoding Add new columns to the data set: nsch_design <- update( nsch_design , one = 1 , state_name = factor( fipsst , levels = c(1L, 2L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 12L, 13L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 53L, 54L, 55L, 56L) , labels = c("Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "District of Columbia", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming") ) , overall_health = factor( c( 1 , 1 , 2 , 3 , 3 )[ k2q01 ] , levels = 1:3 , labels = c( 'excellent or very good' , 'good' , 'fair or poor' ) ) , poverty_categories = factor( 1 + findInterval( fpl , c( 100 , 200 , 400 ) ) , labels = c( "below poverty" , "100-199% fpl" , "200-399% fpl" , "400%+ fpl" ) ) , under_six_ever_breastfed = as.numeric( k6q40 == 1 ) , sc_sex = factor( ifelse( sc_sex %in% 1:2 , sc_sex , NA ) , labels = c( "male" , "female" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: MIcombine( with( nsch_design , svyby( ~ one , ~ one , unwtd.count ) ) ) MIcombine( with( nsch_design , svyby( ~ one , ~ state_name , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: MIcombine( with( nsch_design , svytotal( ~ one ) ) ) MIcombine( with( nsch_design , svyby( ~ one , ~ state_name , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: MIcombine( with( nsch_design , svymean( ~ sc_age_years ) ) ) MIcombine( with( nsch_design , svyby( ~ sc_age_years , ~ state_name , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: MIcombine( with( nsch_design , svymean( ~ poverty_categories ) ) ) MIcombine( with( nsch_design , svyby( ~ poverty_categories , ~ state_name , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: MIcombine( with( nsch_design , svytotal( ~ sc_age_years ) ) ) MIcombine( with( nsch_design , svyby( ~ sc_age_years , ~ state_name , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: MIcombine( with( nsch_design , svytotal( ~ poverty_categories ) ) ) MIcombine( with( nsch_design , svyby( ~ poverty_categories , ~ state_name , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: MIcombine( with( nsch_design , svyquantile( ~ sc_age_years , 0.5 , se = TRUE ) ) ) MIcombine( with( nsch_design , svyby( ~ sc_age_years , ~ state_name , svyquantile , 0.5 , se = TRUE , ci = TRUE ) ) ) Estimate a ratio: MIcombine( with( nsch_design , svyratio( numerator = ~ liveusa_yr , denominator = ~ sc_age_years ) ) ) Subsetting Restrict the survey design to only children: sub_nsch_design <- subset( nsch_design , agepos4 == 1 ) Calculate the mean (average) of this subset: MIcombine( with( sub_nsch_design , svymean( ~ sc_age_years ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- MIcombine( with( nsch_design , svymean( ~ sc_age_years ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- MIcombine( with( nsch_design , svyby( ~ sc_age_years , ~ state_name , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nsch_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: MIcombine( with( nsch_design , svyvar( ~ sc_age_years ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement MIcombine( with( nsch_design , svymean( ~ sc_age_years , deff = TRUE ) ) ) # SRS with replacement MIcombine( with( nsch_design , svymean( ~ sc_age_years , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ under_six_ever_breastfed , nsch_design , # method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( sc_age_years ~ under_six_ever_breastfed , nsch_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ under_six_ever_breastfed + poverty_categories , nsch_design ) Perform a survey-weighted generalized linear model: glm_result <- MIcombine( with( nsch_design , svyglm( sc_age_years ~ under_six_ever_breastfed + poverty_categories ) ) ) summary( glm_result ) Replication Example As noted in the bold red footnotes of their published table, this technique is not correct and should not be used. The technical documents recommend a method matching the MIcombine syntax shown above. Nonetheless, this code matches statistics and confidence intervals within 0.5% from the Excellent or very good column of Indicator 1.1: In general, how would you describe this child’s health?: results <- svyby( ~ as.numeric( overall_health == 'excellent or very good' ) , ~ poverty_categories , nsch_design$designs[[1]] , svymean , na.rm = TRUE ) published_proportions <- c( 0.833 , 0.859 , 0.907 , 0.955 ) published_lb <- c( 0.810 , 0.838 , 0.894 , 0.949 ) published_ub <- c( 0.854 , 0.878 , 0.919 , 0.961 ) stopifnot( all( abs( round( coef( results ) , 3 ) - published_proportions ) < 0.005 ) ) ( ci_results <- confint( results ) ) stopifnot( all( abs( ci_results[ , 1 ] - published_lb ) < 0.005 ) ) stopifnot( all( abs( ci_results[ , 2 ] - published_ub ) < 0.005 ) ) "],["national-survey-on-drug-use-and-health-nsduh.html", "National Survey on Drug Use and Health (NSDUH) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Survey on Drug Use and Health (NSDUH) The primary survey to measure of prevalence of substance use and its correlates in the United States. One table with one row per sampled respondent. A complex survey designed to generalize to civilian, non-institutional americans aged 12 and older. Released periodically since 1979 and annually since 1990. Administered by the Substance Abuse and Mental Health Services Administration. Please skim before you begin: 2021 National Survey on Drug Use and Health (NSDUH): Public Use File Codebook 2021 National Survey on Drug Use and Health (NSDUH): Methodological Summary and Definitions This human-composed haiku or a bouquet of artificial intelligence-generated limericks # drinking and thinking # about your first time, were you # smoking and joking? Download, Import, Preparation Download and import the national file: zip_tf <- tempfile() zip_url <- paste0( "https://www.datafiles.samhsa.gov/sites/default/files/field-uploads-protected/" , "studies/NSDUH-2021/NSDUH-2021-datasets/NSDUH-2021-DS0001/" , "NSDUH-2021-DS0001-bundles-with-study-info/NSDUH-2021-DS0001-bndl-data-r_v3.zip" ) download.file( zip_url , zip_tf , mode = 'wb' ) nsduh_rdata <- unzip( zip_tf , exdir = tempdir() ) nsduh_rdata_contents <- load( nsduh_rdata ) nsduh_df_name <- grep( 'PUF' , nsduh_rdata_contents , value = TRUE ) nsduh_df <- get( nsduh_df_name ) names( nsduh_df ) <- tolower( names( nsduh_df ) ) nsduh_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # nsduh_fn <- file.path( path.expand( "~" ) , "NSDUH" , "this_file.rds" ) # saveRDS( nsduh_df , file = nsduh_fn , compress = FALSE ) Load the same object: # nsduh_df <- readRDS( nsduh_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) nsduh_design <- svydesign( id = ~ verep , strata = ~ vestr_c , data = nsduh_df , weights = ~ analwt_c , nest = TRUE ) Variable Recoding Add new columns to the data set: nsduh_design <- update( nsduh_design , one = 1 , health = factor( health , levels = 1:5 , labels = c( "excellent" , "very good" , "good" , "fair" , "poor" ) ) , age_first_cigarette = ifelse( cigtry > 99 , NA , cigtry ) , age_tried_cocaine = ifelse( cocage > 99 , NA , cocage ) , ever_used_marijuana = as.numeric( ifelse( mjever < 4 , mjever == 1 , NA ) ) , county_type = factor( coutyp4 , levels = 1:3 , labels = c( "large metro" , "small metro" , "nonmetro" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nsduh_design , "sampling" ) != 0 ) svyby( ~ one , ~ county_type , nsduh_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nsduh_design ) svyby( ~ one , ~ county_type , nsduh_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ age_first_cigarette , nsduh_design , na.rm = TRUE ) svyby( ~ age_first_cigarette , ~ county_type , nsduh_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ health , nsduh_design , na.rm = TRUE ) svyby( ~ health , ~ county_type , nsduh_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ age_first_cigarette , nsduh_design , na.rm = TRUE ) svyby( ~ age_first_cigarette , ~ county_type , nsduh_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ health , nsduh_design , na.rm = TRUE ) svyby( ~ health , ~ county_type , nsduh_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ age_first_cigarette , nsduh_design , 0.5 , na.rm = TRUE ) svyby( ~ age_first_cigarette , ~ county_type , nsduh_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ age_first_cigarette , denominator = ~ age_tried_cocaine , nsduh_design , na.rm = TRUE ) Subsetting Restrict the survey design to individuals who are pregnant: sub_nsduh_design <- subset( nsduh_design , preg == 1 ) Calculate the mean (average) of this subset: svymean( ~ age_first_cigarette , sub_nsduh_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ age_first_cigarette , nsduh_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ age_first_cigarette , ~ county_type , nsduh_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nsduh_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ age_first_cigarette , nsduh_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ age_first_cigarette , nsduh_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ age_first_cigarette , nsduh_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ ever_used_marijuana , nsduh_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( age_first_cigarette ~ ever_used_marijuana , nsduh_design ) Perform a chi-squared test of association for survey data: svychisq( ~ ever_used_marijuana + health , nsduh_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( age_first_cigarette ~ ever_used_marijuana + health , nsduh_design ) summary( glm_result ) Replication Example This matches the prevalence and SE of alcohol use in the past month from Codebook Table G.2: result <- svymean( ~ alcmon , nsduh_design ) stopifnot( round( coef( result ) , 3 ) == 0.474 ) stopifnot( round( SE( result ) , 4 ) == 0.0043 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NSDUH users, this code replicates previously-presented examples: library(srvyr) nsduh_srvyr_design <- as_survey( nsduh_design ) Calculate the mean (average) of a linear variable, overall and by groups: nsduh_srvyr_design %>% summarize( mean = survey_mean( age_first_cigarette , na.rm = TRUE ) ) nsduh_srvyr_design %>% group_by( county_type ) %>% summarize( mean = survey_mean( age_first_cigarette , na.rm = TRUE ) ) "],["national-survey-of-family-growth-nsfg.html", "National Survey of Family Growth (NSFG) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " National Survey of Family Growth (NSFG) The principal survey to measure reproductive behavior in the United States population. Multiple tables with one row per respondent for the female and male tables, then a separate table with one row per pregnancy. A complex sample survey designed to generalize to the 15-49 year old population of the United States, by gender. Released every couple of years since 1973. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: Sample Design Documentation Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # family structure # questions cuz radar fails at # storks with bassinets Download, Import, Preparation library(SAScii) library(readr) dat_url <- "https://ftp.cdc.gov/pub/Health_Statistics/NCHS/Datasets/NSFG/2017_2019_FemRespData.dat" sas_url <- file.path( dirname( dat_url ) , "sas/2017_2019_FemRespSetup.sas" ) sas_positions <- parse.SAScii( sas_url ) sas_positions[ , 'varname' ] <- tolower( sas_positions[ , 'varname' ] ) sas_positions[ , 'column_types' ] <- ifelse( sas_positions[ , 'char' ] , "c" , "d" ) nsfg_tbl <- read_fwf( dat_url , fwf_widths( abs( sas_positions[ , 'width' ] ) , col_names = sas_positions[ , 'varname' ] ) , col_types = paste0( sas_positions[ , 'column_types' ] , collapse = "" ) , na = c( "" , "." ) ) nsfg_df <- data.frame( nsfg_tbl ) Save locally   Save the object at any point: # nsfg_fn <- file.path( path.expand( "~" ) , "NSFG" , "this_file.rds" ) # saveRDS( nsfg_df , file = nsfg_fn , compress = FALSE ) Load the same object: # nsfg_df <- readRDS( nsfg_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) nsfg_design <- svydesign( id = ~ secu , strata = ~ sest , data = nsfg_df , weights = ~ wgt2017_2019 , nest = TRUE ) Variable Recoding Add new columns to the data set: nsfg_design <- update( nsfg_design , one = 1 , birth_control_pill = as.numeric( constat1 == 6 ) , age_categories = factor( findInterval( ager , c( 15 , 20 , 25 , 30 , 35 , 40 ) ) , labels = c( '15-19' , '20-24' , '25-29' , '30-34' , '35-39' , '40-49' ) ) , marstat = factor( marstat , levels = c( 1:6 , 8:9 ) , labels = c( "Married to a person of the opposite sex" , "Not married but living together with a partner of the opposite sex" , "Widowed" , "Divorced or annulled" , "Separated, because you and your spouse are not getting along" , "Never been married" , "Refused" , "Don't know" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nsfg_design , "sampling" ) != 0 ) svyby( ~ one , ~ age_categories , nsfg_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nsfg_design ) svyby( ~ one , ~ age_categories , nsfg_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ pregnum , nsfg_design , na.rm = TRUE ) svyby( ~ pregnum , ~ age_categories , nsfg_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ marstat , nsfg_design ) svyby( ~ marstat , ~ age_categories , nsfg_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ pregnum , nsfg_design , na.rm = TRUE ) svyby( ~ pregnum , ~ age_categories , nsfg_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ marstat , nsfg_design ) svyby( ~ marstat , ~ age_categories , nsfg_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ pregnum , nsfg_design , 0.5 , na.rm = TRUE ) svyby( ~ pregnum , ~ age_categories , nsfg_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ pregnum , denominator = ~ lbpregs , nsfg_design , na.rm = TRUE ) Subsetting Restrict the survey design to ever cohabited: sub_nsfg_design <- subset( nsfg_design , timescoh > 0 ) Calculate the mean (average) of this subset: svymean( ~ pregnum , sub_nsfg_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ pregnum , nsfg_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ pregnum , ~ age_categories , nsfg_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nsfg_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ pregnum , nsfg_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ pregnum , nsfg_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ pregnum , nsfg_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ birth_control_pill , nsfg_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( pregnum ~ birth_control_pill , nsfg_design ) Perform a chi-squared test of association for survey data: svychisq( ~ birth_control_pill + marstat , nsfg_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( pregnum ~ birth_control_pill + marstat , nsfg_design ) summary( glm_result ) Replication Example This example matches the Variance Estimates for Percentages using SAS (9.4) and STATA (14): Match the sum of the weights: result <- svytotal( ~ one , nsfg_design ) stopifnot( round( coef( result ) , 0 ) == 72671926 ) stopifnot( round( SE( result ) , 0 ) == 3521465 ) Match row percentages of women currently using the pill by age: row_percents <- c( 19.5112 , 23.7833 , 19.6916 , 15.2800 , 6.4965 , 6.5215 ) std_err_row_percents <- c( 1.8670 , 2.1713 , 2.2773 , 1.7551 , 0.9895 , 1.0029 ) results <- svyby( ~ birth_control_pill , ~ age_categories , nsfg_design , svymean ) stopifnot( all( round( coef( results ) * 100 , 4 ) == row_percents ) ) stopifnot( all( round( SE( results ) * 100 , 4 ) == std_err_row_percents ) ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NSFG users, this code replicates previously-presented examples: library(srvyr) nsfg_srvyr_design <- as_survey( nsfg_design ) Calculate the mean (average) of a linear variable, overall and by groups: nsfg_srvyr_design %>% summarize( mean = survey_mean( pregnum , na.rm = TRUE ) ) nsfg_srvyr_design %>% group_by( age_categories ) %>% summarize( mean = survey_mean( pregnum , na.rm = TRUE ) ) "],["new-york-city-housing-and-vacancy-survey-nychvs.html", "New York City Housing and Vacancy Survey (NYCHVS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " New York City Housing and Vacancy Survey (NYCHVS) A city-wide assessment of the rental vacancy rate and other characteristics related to housing stock. One table with one record per occupied housing unit, a second table with one record per person inside each occupied housing unit, and a third table with one record per unoccupied housing unit. A complex sample designed to generalize to occupied & unoccupied housing in the five boroughs. Released more or less triennially since 1991. Funded by the NYC Dept. of Housing Preservation & Development, run by the Census Bureau. Please skim before you begin: Public Use File User Guide and Codebook Sample Design, Weighting, and Error Estimation This human-composed haiku or a bouquet of artificial intelligence-generated limericks # all i want is a # room somewhere / with clawfoot tub # and a frigidaire Download, Import, Preparation Define a function to download and import each comma-separated value file: nychvs_csv_import <- function( this_url ){ tf <- tempfile() download.file( this_url , tf , mode = 'wb' ) this_df <- read.csv( tf ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the all units, occupied units, person, and vacant units tables: datasets_url <- "https://www2.census.gov/programs-surveys/nychvs/datasets/2021/microdata/" all_units_df <- nychvs_csv_import( paste0( datasets_url , "allunits_puf_21.csv" ) ) occupied_units_df <- nychvs_csv_import( paste0( datasets_url , "occupied_puf_21.csv" ) ) person_df <- nychvs_csv_import( paste0( datasets_url , "person_puf_21.csv" ) ) vacant_units_df <- nychvs_csv_import( paste0( datasets_url , "vacant_puf_21.csv" ) ) stopifnot( nrow( all_units_df ) == nrow( occupied_units_df ) + nrow( vacant_units_df ) ) Merge the information stored in the all units table onto both the occupied and vacant unit tables, then merge the information (not related to weighting) from the occupied unit table onto the person table: before_nrow <- nrow( occupied_units_df ) occupied_units_df <- merge( all_units_df , occupied_units_df ) stopifnot( nrow( occupied_units_df ) == before_nrow ) before_nrow <- nrow( vacant_units_df ) vacant_units_df <- merge( all_units_df , vacant_units_df ) stopifnot( nrow( vacant_units_df ) == before_nrow ) before_nrow <- nrow( person_df ) weighting_variables <- grep( "^fw([0-9]+)?$" , names( occupied_units_df ) , value = TRUE ) person_df <- merge( occupied_units_df[ setdiff( names( occupied_units_df ) , weighting_variables ) ] , person_df ) stopifnot( nrow( person_df ) == before_nrow ) all_units_df[ , 'one' ] <- occupied_units_df[ , 'one' ] <- vacant_units_df[ , 'one' ] <- person_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # nychvs_fn <- file.path( path.expand( "~" ) , "NYCHVS" , "this_file.rds" ) # saveRDS( nychvs_df , file = nychvs_fn , compress = FALSE ) Load the same object: # nychvs_df <- readRDS( nychvs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) all_units_design <- svrepdesign( weight = ~fw , repweights = 'fw[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = all_units_df ) occupied_units_design <- svrepdesign( weight = ~fw , repweights = 'fw[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = occupied_units_df ) vacant_units_design <- svrepdesign( weight = ~fw , repweights = 'fw[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = vacant_units_df ) person_design <- svrepdesign( weight = ~pw , repweights = 'pw[0-9]+' , scale = 4 / 80 , rscales = rep( 1 , 80 ) , mse = TRUE , type = 'JK1' , data = person_df ) nychvs_design <- occupied_units_design Variable Recoding Add new columns to the data set: nychvs_design <- update( nychvs_design , one = 1 , home_owners = as.numeric( tenure == 2 ) , yearly_household_income = hhinc_rec1 , rent_amount = ifelse( rent_amount == -2 , NA , rent_amount ) , borough = factor( boro , levels = 1:5 , labels = c( 'Bronx' , 'Brooklyn' , 'Manhattan' , 'Queens' , 'Staten Island' ) ) , food_insecurity = factor( foodinsecure , levels = 1:3 , labels = c( 'not insecure' , 'insecure' , 'very insecure' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( nychvs_design , "sampling" ) != 0 ) svyby( ~ one , ~ borough , nychvs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , nychvs_design ) svyby( ~ one , ~ borough , nychvs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) svyby( ~ hhinc_rec1 , ~ borough , nychvs_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ food_insecurity , nychvs_design , na.rm = TRUE ) svyby( ~ food_insecurity , ~ borough , nychvs_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) svyby( ~ hhinc_rec1 , ~ borough , nychvs_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ food_insecurity , nychvs_design , na.rm = TRUE ) svyby( ~ food_insecurity , ~ borough , nychvs_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ hhinc_rec1 , nychvs_design , 0.5 , na.rm = TRUE ) svyby( ~ hhinc_rec1 , ~ borough , nychvs_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ rent_amount , denominator = ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) Subsetting Restrict the survey design to rent burdened units (more than 30% of income paid toward rent alone): sub_nychvs_design <- subset( nychvs_design , rentburden_cat %in% 1:2 ) Calculate the mean (average) of this subset: svymean( ~ hhinc_rec1 , sub_nychvs_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ hhinc_rec1 , ~ borough , nychvs_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( nychvs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ hhinc_rec1 , nychvs_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ home_owners , nychvs_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( hhinc_rec1 ~ home_owners , nychvs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ home_owners + food_insecurity , nychvs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( hhinc_rec1 ~ home_owners + food_insecurity , nychvs_design ) summary( glm_result ) Replication Example This example matches the estimate and standard error of the number of occupied housing units across the five boroughs shown at minute 6:05: result <- svytotal( ~ one , nychvs_design ) stopifnot( round( coef( result ) , 0 ) == 3157105 ) stopifnot( round( SE( result ) , 0 ) == 13439 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for NYCHVS users, this code replicates previously-presented examples: library(srvyr) nychvs_srvyr_design <- as_survey( nychvs_design ) Calculate the mean (average) of a linear variable, overall and by groups: nychvs_srvyr_design %>% summarize( mean = survey_mean( hhinc_rec1 , na.rm = TRUE ) ) nychvs_srvyr_design %>% group_by( borough ) %>% summarize( mean = survey_mean( hhinc_rec1 , na.rm = TRUE ) ) "],["programme-for-the-international-assessment-of-adult-competencies-piaac.html", "Programme for the International Assessment of Adult Competencies (PIAAC) Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Programme for the International Assessment of Adult Competencies (PIAAC) A cross-national study designed to understand the skills of workers in advanced-nation labor markets. One row per sampled adult. A multiply-imputed, complex sample survey designed to generalize to the population aged 16 to 65 across thirty three OECD nations. No expected release timeline. Administered by the Organisation for Economic Co-operation and Development. Please skim before you begin: Technical Report of the Survey of Adult Skills Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # what color collar # workforce poets, potters, or # pythagoreans Download, Import, Preparation library(haven) library(httr) tf <- tempfile() this_url <- "https://webfs.oecd.org/piaac/puf-data/SAS/SAS7BDAT/prgusap1_2012.sas7bdat" GET( this_url , write_disk( tf ) , progress() ) piaac_tbl <- read_sas( tf ) piaac_df <- data.frame( piaac_tbl ) names( piaac_df ) <- tolower( names( piaac_df ) ) Save locally   Save the object at any point: # piaac_fn <- file.path( path.expand( "~" ) , "PIAAC" , "this_file.rds" ) # saveRDS( piaac_df , file = piaac_fn , compress = FALSE ) Load the same object: # piaac_df <- readRDS( piaac_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: library(survey) library(mitools) pvals <- c( "pvlit" , "pvnum" , "pvpsl" ) pvars <- outer( pvals , 1:10 , paste0 ) non.pvals <- names(piaac_df)[ !( names(piaac_df) %in% pvars ) ] for(k in 1:10){ piaac_imp <- piaac_df[ , c( non.pvals , paste0( pvals , k ) ) ] for( j in pvals ){ piaac_imp[ , j ] <- piaac_imp[ , paste0( j , k ) ] piaac_imp[ , paste0( j , k ) ] <- NULL } if( k == 1 ){ piaac_mi <- list( piaac_imp ) } else { piaac_mi <- c( piaac_mi , list( piaac_imp ) ) } } jk.method <- unique( piaac_df[ , 'vemethod' ] ) stopifnot(length(jk.method) == 1) stopifnot(jk.method %in% c("JK1", "JK2")) if (jk.method == "JK2") jk.method <- "JKn" piaac_design <- svrepdesign( weights = ~spfwt0 , repweights = "spfwt[1-9]" , rscales = rep( 1 , 80 ) , scale = ifelse( jk.method == "JKn" , 1 , 79/80 ) , type = jk.method , data = imputationList( piaac_mi ) , mse = TRUE ) Variable Recoding Add new columns to the data set: piaac_design <- update( piaac_design , one = 1 , sex = factor( gender_r , labels = c( "male" , "female" ) ) , age_categories = factor( ageg10lfs , levels = 1:5 , labels = c( "24 or less" , "25-34" , "35-44" , "45-54" , "55 plus" ) ) , working_at_paid_job_last_week = as.numeric( c_q01a == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: MIcombine( with( piaac_design , svyby( ~ one , ~ one , unwtd.count ) ) ) MIcombine( with( piaac_design , svyby( ~ one , ~ age_categories , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: MIcombine( with( piaac_design , svytotal( ~ one ) ) ) MIcombine( with( piaac_design , svyby( ~ one , ~ age_categories , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE ) ) ) MIcombine( with( piaac_design , svyby( ~ pvnum , ~ age_categories , svymean , na.rm = TRUE ) ) ) Calculate the distribution of a categorical variable, overall and by groups: MIcombine( with( piaac_design , svymean( ~ sex ) ) ) MIcombine( with( piaac_design , svyby( ~ sex , ~ age_categories , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: MIcombine( with( piaac_design , svytotal( ~ pvnum , na.rm = TRUE ) ) ) MIcombine( with( piaac_design , svyby( ~ pvnum , ~ age_categories , svytotal , na.rm = TRUE ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: MIcombine( with( piaac_design , svytotal( ~ sex ) ) ) MIcombine( with( piaac_design , svyby( ~ sex , ~ age_categories , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: MIcombine( with( piaac_design , svyquantile( ~ pvnum , 0.5 , se = TRUE , na.rm = TRUE ) ) ) MIcombine( with( piaac_design , svyby( ~ pvnum , ~ age_categories , svyquantile , 0.5 , se = TRUE , ci = TRUE , na.rm = TRUE ) ) ) Estimate a ratio: MIcombine( with( piaac_design , svyratio( numerator = ~ pvnum , denominator = ~ pvlit , na.rm = TRUE ) ) ) Subsetting Restrict the survey design to self-reported fair or poor health: sub_piaac_design <- subset( piaac_design , i_q08 %in% 4:5 ) Calculate the mean (average) of this subset: MIcombine( with( sub_piaac_design , svymean( ~ pvnum , na.rm = TRUE ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- MIcombine( with( piaac_design , svyby( ~ pvnum , ~ age_categories , svymean , na.rm = TRUE ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( piaac_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: MIcombine( with( piaac_design , svyvar( ~ pvnum , na.rm = TRUE ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE , deff = TRUE ) ) ) # SRS with replacement MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ working_at_paid_job_last_week , piaac_design , # method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( pvnum ~ working_at_paid_job_last_week , piaac_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ working_at_paid_job_last_week + sex , piaac_design ) Perform a survey-weighted generalized linear model: glm_result <- MIcombine( with( piaac_design , svyglm( pvnum ~ working_at_paid_job_last_week + sex ) ) ) summary( glm_result ) Replication Example This example matches the statistics and standard errors from OECD’s Technical Report Table 18.9: usa_pvlit <- MIcombine( with( piaac_design , svymean( ~ pvlit , na.rm = TRUE ) ) ) usa_pvnum <- MIcombine( with( piaac_design , svymean( ~ pvnum , na.rm = TRUE ) ) ) usa_pvpsl <- MIcombine( with( piaac_design , svymean( ~ pvpsl , na.rm = TRUE ) ) ) stopifnot( round( coef( usa_pvlit ) ) == 270 ) stopifnot( round( SE( usa_pvlit ) , 1 ) == 1.0 ) stopifnot( round( coef( usa_pvnum ) ) == 253 ) stopifnot( round( SE( usa_pvnum ) , 1 ) == 1.2 ) stopifnot( round( coef( usa_pvpsl ) ) == 277 ) stopifnot( round( SE( usa_pvpsl ) , 1 ) == 1.1 ) "],["progress-in-international-reading-literacy-study-pirls.html", "Progress in International Reading Literacy Study (PIRLS) Function Definitions Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Progress in International Reading Literacy Study (PIRLS) A comparative study of student achievement in reading and literacy across more than 50 nations. Grade-specific tables with one record per school, student, teacher, plus files containing student achievement, home background, student-teacher linkage, and within-country scoring reliability. A complex survey generalizing to fourth-grade populations of participating countries. Released quinquennially since 2001. Funded by the International Association for the Evaluation of Educational Achievement, run at BC. Please skim before you begin: PIRLS 2021 User Guide for the International Database Methods and Procedures: PIRLS 2021 Technical Report This human-composed haiku or a bouquet of artificial intelligence-generated limericks # lascaux canary # glyph jump reveal caged bard notes # cryogenesis Function Definitions This survey uses a multiply-imputed variance estimation technique described in Methods Chapter 13. Most users do not need to study this function carefully. Define a function specific to only this dataset: pirls_MIcombine <- function (results, variances, call = sys.call(), df.complete = Inf, ...) { m <- length(results) oldcall <- attr(results, "call") if (missing(variances)) { variances <- suppressWarnings(lapply(results, vcov)) results <- lapply(results, coef) } vbar <- variances[[1]] cbar <- results[[1]] for (i in 2:m) { cbar <- cbar + results[[i]] vbar <- vbar + variances[[i]] } cbar <- cbar/m vbar <- vbar/m # MODIFICATION # evar <- var(do.call("rbind", results)) evar <- sum( ( unlist( results ) - cbar )^2 / 4 ) r <- (1 + 1/m) * evar/vbar df <- (m - 1) * (1 + 1/r)^2 if (is.matrix(df)) df <- diag(df) if (is.finite(df.complete)) { dfobs <- ((df.complete + 1)/(df.complete + 3)) * df.complete * vbar/(vbar + evar) if (is.matrix(dfobs)) dfobs <- diag(dfobs) df <- 1/(1/dfobs + 1/df) } if (is.matrix(r)) r <- diag(r) rval <- list(coefficients = cbar, variance = vbar + evar * (m + 1)/m, call = c(oldcall, call), nimp = m, df = df, missinfo = (r + 2/(df + 3))/(r + 1)) class(rval) <- "MIresult" rval } Download, Import, Preparation Download and unzip the 2021 fourth grade international database: library(httr) tf <- tempfile() this_url <- "https://pirls2021.org/data/downloads/P21_Data_R.zip" GET( this_url , write_disk( tf ) , progress() ) unzipped_files <- unzip( tf , exdir = tempdir() ) Import and stack each of the student context data files for Abu Dhabi through Bulgaria: library(haven) # limit unzipped files to those starting with `asg` followed by three letters followed by `r5` asg_fns <- unzipped_files[ grepl( '^asg[a-z][a-z][a-z]r5' , basename( unzipped_files ) , ignore.case = TRUE ) ] # further limit asg files to the first ten countries countries_thru_bulgaria <- c("aad", "adu", "alb", "are", "aus", "aut", "aze", "bfl", "bfr", "bgr") fns_thru_bulgaria <- paste0( paste0( '^asg' , countries_thru_bulgaria , 'r5' ) , collapse = "|" ) asg_aad_bgr_fns <- asg_fns[ grepl( fns_thru_bulgaria , basename( asg_fns ) , ignore.case = TRUE ) ] pirls_df <- NULL for( rdata_fn in asg_aad_bgr_fns ){ this_tbl_name <- load( rdata_fn ) this_tbl <- get( this_tbl_name ) ; rm( this_tbl_name ) this_tbl <- zap_labels( this_tbl ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) pirls_df <- rbind( pirls_df , this_df ) } # order the data.frame by unique student id pirls_df <- pirls_df[ with( pirls_df , order( idcntry , idstud ) ) , ] Save locally   Save the object at any point: # pirls_fn <- file.path( path.expand( "~" ) , "PIRLS" , "this_file.rds" ) # saveRDS( pirls_df , file = pirls_fn , compress = FALSE ) Load the same object: # pirls_df <- readRDS( pirls_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: From among possibly plausible values, determine all columns that are multiply-imputed plausible values: # identify all columns ending with `01` thru `05` ppv <- grep( "(.*)0[1-5]$" , names( pirls_df ) , value = TRUE ) # remove those ending digits ppv_prefix <- gsub( "0[1-5]$" , "" , ppv ) # identify each of the possibilities with exactly five matches (five implicates) pv <- names( table( ppv_prefix )[ table( ppv_prefix ) == 5 ] ) # identify each of the `01` thru `05` plausible value columns pv_columns <- grep( paste0( "^" , pv , "0[1-5]$" , collapse = "|" ) , names( pirls_df ) , value = TRUE ) Extract those multiply-imputed columns into a separate data.frame, then remove them from the source: pv_wide_df <- pirls_df[ c( 'idcntry' , 'idstud' , pv_columns ) ] pirls_df[ pv_columns ] <- NULL Reshape these columns from one record per student to one record per student per implicate: pv_long_df <- reshape( pv_wide_df , varying = lapply( paste0( pv , '0' ) , paste0 , 1:5 ) , direction = 'long' , timevar = 'implicate' , idvar = c( 'idcntry' , 'idstud' ) ) names( pv_long_df ) <- gsub( "01$" , "" , names( pv_long_df ) ) Merge the columns from the source data.frame onto the one record per student per implicate data.frame: pirls_long_df <- merge( pirls_df , pv_long_df ) pirls_long_df <- pirls_long_df[ with( pirls_long_df , order( idcntry , idstud ) ) , ] stopifnot( nrow( pirls_long_df ) == nrow( pv_long_df ) ) stopifnot( nrow( pirls_long_df ) / 5 == nrow( pirls_df ) ) Divide the five plausible value implicates into a list with five data.frames based on the implicate number: pirls_list <- split( pirls_long_df , pirls_long_df[ , 'implicate' ] ) Construct a replicate weights table following the estimation technique described in Methods Chapter 13: weights_df <- pirls_df[ c( 'jkrep' , 'jkzone' ) ] for( j in 1:75 ){ for( i in 0:1 ){ weights_df[ weights_df[ , 'jkzone' ] != j , paste0( 'rw' , i , j ) ] <- 1 weights_df[ weights_df[ , 'jkzone' ] == j , paste0( 'rw' , i , j ) ] <- 2 * ( weights_df[ weights_df[ , 'jkzone' ] == j , 'jkrep' ] == i ) } } weights_df[ c( 'jkrep' , 'jkzone' ) ] <- NULL Define the design: library(survey) library(mitools) pirls_design <- svrepdesign( weights = ~totwgt , repweights = weights_df , data = imputationList( pirls_list ) , type = "other" , scale = 0.5 , rscales = rep( 1 , 150 ) , combined.weights = FALSE , mse = TRUE ) Variable Recoding Add new columns to the data set: pirls_design <- update( pirls_design , one = 1 , countries_thru_bulgaria = factor( as.numeric( idcntry ) , levels = c(7842L, 7841L, 8L, 784L, 36L, 40L, 31L, 956L, 957L, 100L) , labels = c("Abu Dhabi, UAE", "Dubai, UAE", "Albania", "UAE", "Australia", "Austria", "Azerbaijan", "Belgium (Flemish)", "Belgium (French)","Bulgaria") ) , sex = factor( itsex , levels = 1:2 , labels = c( "female" , "male" ) ) , always_speak_language_of_test_at_home = ifelse( asbg03 %in% 1:4 , as.numeric( asbg03 == 1 ) , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: pirls_MIcombine( with( pirls_design , svyby( ~ one , ~ one , unwtd.count ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ one , ~ sex , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: pirls_MIcombine( with( pirls_design , svytotal( ~ one ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ one , ~ sex , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: pirls_MIcombine( with( pirls_design , svymean( ~ asrrea , na.rm = TRUE ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ asrrea , ~ sex , svymean , na.rm = TRUE ) ) ) Calculate the distribution of a categorical variable, overall and by groups: pirls_MIcombine( with( pirls_design , svymean( ~ countries_thru_bulgaria ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ countries_thru_bulgaria , ~ sex , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: pirls_MIcombine( with( pirls_design , svytotal( ~ asrrea , na.rm = TRUE ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ asrrea , ~ sex , svytotal , na.rm = TRUE ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: pirls_MIcombine( with( pirls_design , svytotal( ~ countries_thru_bulgaria ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ countries_thru_bulgaria , ~ sex , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: pirls_MIcombine( with( pirls_design , svyquantile( ~ asrrea , 0.5 , se = TRUE , na.rm = TRUE ) ) ) pirls_MIcombine( with( pirls_design , svyby( ~ asrrea , ~ sex , svyquantile , 0.5 , se = TRUE , ci = TRUE , na.rm = TRUE ) ) ) Estimate a ratio: pirls_MIcombine( with( pirls_design , svyratio( numerator = ~ asrlit , denominator = ~ asrrea ) ) ) Subsetting Restrict the survey design to Australia, Austria, Azerbaijan, Belgium (French): sub_pirls_design <- subset( pirls_design , idcntry %in% c( 36 , 40 , 31 , 956 ) ) Calculate the mean (average) of this subset: pirls_MIcombine( with( sub_pirls_design , svymean( ~ asrrea , na.rm = TRUE ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- pirls_MIcombine( with( pirls_design , svymean( ~ asrrea , na.rm = TRUE ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- pirls_MIcombine( with( pirls_design , svyby( ~ asrrea , ~ sex , svymean , na.rm = TRUE ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( pirls_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: pirls_MIcombine( with( pirls_design , svyvar( ~ asrrea , na.rm = TRUE ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement pirls_MIcombine( with( pirls_design , svymean( ~ asrrea , na.rm = TRUE , deff = TRUE ) ) ) # SRS with replacement pirls_MIcombine( with( pirls_design , svymean( ~ asrrea , na.rm = TRUE , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ always_speak_language_of_test_at_home , pirls_design , # method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( asrrea ~ always_speak_language_of_test_at_home , pirls_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ always_speak_language_of_test_at_home + countries_thru_bulgaria , pirls_design ) Perform a survey-weighted generalized linear model: glm_result <- pirls_MIcombine( with( pirls_design , svyglm( asrrea ~ always_speak_language_of_test_at_home + countries_thru_bulgaria ) ) ) summary( glm_result ) Replication Example This example matches the mean proficiency and standard error of the Australia row of the Summary Statistics and Standard Errors for Proficiency in Overall Reading table from the Appendix 13A: Summary Statistics and Standard Errors for Proficiency in Reading: australia_design <- subset( pirls_design , countries_thru_bulgaria %in% "Australia" ) stopifnot( nrow( australia_design ) == 5487 ) result <- pirls_MIcombine( with( australia_design , svymean( ~ asrrea ) ) ) stopifnot( round( coef( result ) , 3 ) == 540.134 ) stopifnot( round( SE( result ) , 3 ) == 1.728 ) This example matches the jackknife sampling, imputation, and total variances of the same row: australia_fn <- unzipped_files[ grepl( 'ASGAUS' , basename( unzipped_files ) ) ] australia_tbl_name <- load( australia_fn ) australia_tbl <- get( australia_tbl_name ) ; rm( australia_tbl_name ) australia_tbl <- zap_labels( australia_tbl ) australia_df <- data.frame( australia_tbl ) names( australia_df ) <- tolower( names( australia_df ) ) estimate <- mean( c( with( australia_df , weighted.mean( asrrea01 , totwgt ) ) , with( australia_df , weighted.mean( asrrea02 , totwgt ) ) , with( australia_df , weighted.mean( asrrea03 , totwgt ) ) , with( australia_df , weighted.mean( asrrea04 , totwgt ) ) , with( australia_df , weighted.mean( asrrea05 , totwgt ) ) ) ) stopifnot( round( estimate , 3 ) == 540.134 ) for( k in 1:5 ){ this_variance <- 0 for( j in 1:75 ){ for( i in 0:1 ){ this_variance <- this_variance + ( weighted.mean( australia_df[ , paste0( 'asrrea0' , k ) ] , ifelse( j == australia_df[ , 'jkzone' ] , australia_df[ , 'totwgt' ] * 2 * ( australia_df[ , 'jkrep' ] == i ) , australia_df[ , 'totwgt' ] ) ) - weighted.mean( australia_df[ , paste0( 'asrrea0' , k ) ] , australia_df[ , 'totwgt' ] ) )^2 } } assign( paste0( 'v' , k ) , this_variance * 0.5 ) } sampling_variance <- mean( c( v1 , v2 , v3 , v4 , v5 ) ) stopifnot( round( sampling_variance , 3 ) == 2.653 ) imputation_variance <- ( 6 / 5 ) * ( ( ( with( australia_df , weighted.mean( asrrea01 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asrrea02 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asrrea03 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asrrea04 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asrrea05 , totwgt ) ) - estimate )^2 / 4 ) ) stopifnot( round( imputation_variance , 3 ) == 0.333 ) stopifnot( round( sampling_variance + imputation_variance , 3 ) == 2.987 ) "],["public-libraries-survey-pls.html", "Public Libraries Survey (PLS) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Public Libraries Survey (PLS) A comprehensive compilation of administrative information on all public libraries in the United States. Two tables, with one record per library system and one record per library building or bookmobile. Released annually since 1992. Conducted by the Institute of Museum and Library Services (IMLS), collected by the Census Bureau. Please skim before you begin: Data File Documentation and User’s Guide README FY #### PLS PUD.txt included in each zipped file This human-composed haiku or a bouquet of artificial intelligence-generated limericks # census, not survey. # dewey decimal index # finger to lips shush Download, Import, Preparation Download and import the most recent administrative entity csv file: this_tf <- tempfile() csv_url <- "https://www.imls.gov/sites/default/files/2023-06/pls_fy2021_csv.zip" download.file( csv_url , this_tf, mode = 'wb' ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) administrative_entity_csv_fn <- unzipped_files[ grepl( 'AE(.*)csv$' , basename( unzipped_files ) ) ] pls_df <- read.csv( administrative_entity_csv_fn ) names( pls_df ) <- tolower( names( pls_df ) ) pls_df[ , 'one' ] <- 1 Recode missing values as described in the readme included with each zipped file: for( this_col in names( pls_df ) ){ if( class( pls_df[ , this_col ] ) == 'character' ){ pls_df[ pls_df[ , this_col ] %in% 'M' , this_col ] <- NA } if( ( class( pls_df[ , this_col ] ) == 'numeric' ) | ( this_col %in% c( 'phone' , 'startdat' , 'enddate' ) ) ){ pls_df[ pls_df[ , this_col ] %in% c( -1 , -3 , -4 , -9 ) , this_col ] <- NA } } Save locally   Save the object at any point: # pls_fn <- file.path( path.expand( "~" ) , "PLS" , "this_file.rds" ) # saveRDS( pls_df , file = pls_fn , compress = FALSE ) Load the same object: # pls_df <- readRDS( pls_fn ) Variable Recoding Add new columns to the data set: pls_df <- transform( pls_df , c_relatn = factor( c_relatn , levels = c( "HQ" , "ME" , "NO" ) , c( "HQ-Headquarters of a federation or cooperative" , "ME-Member of a federation or cooperative" , "NO-Not a member of a federation or cooperative" ) ) , more_than_one_librarian = as.numeric( libraria > 1 ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( pls_df ) table( pls_df[ , "stabr" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( pls_df[ , "popu_lsa" ] , na.rm = TRUE ) tapply( pls_df[ , "popu_lsa" ] , pls_df[ , "stabr" ] , mean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( pls_df[ , "c_relatn" ] ) ) prop.table( table( pls_df[ , c( "c_relatn" , "stabr" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( pls_df[ , "popu_lsa" ] , na.rm = TRUE ) tapply( pls_df[ , "popu_lsa" ] , pls_df[ , "stabr" ] , sum , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( pls_df[ , "popu_lsa" ] , 0.5 , na.rm = TRUE ) tapply( pls_df[ , "popu_lsa" ] , pls_df[ , "stabr" ] , quantile , 0.5 , na.rm = TRUE ) Subsetting Limit your data.frame to more than one million annual visits: sub_pls_df <- subset( pls_df , visits > 1000000 ) Calculate the mean (average) of this subset: mean( sub_pls_df[ , "popu_lsa" ] , na.rm = TRUE ) Measures of Uncertainty Calculate the variance, overall and by groups: var( pls_df[ , "popu_lsa" ] , na.rm = TRUE ) tapply( pls_df[ , "popu_lsa" ] , pls_df[ , "stabr" ] , var , na.rm = TRUE ) Regression Models and Tests of Association Perform a t-test: t.test( popu_lsa ~ more_than_one_librarian , pls_df ) Perform a chi-squared test of association: this_table <- table( pls_df[ , c( "more_than_one_librarian" , "c_relatn" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( popu_lsa ~ more_than_one_librarian + c_relatn , data = pls_df ) summary( glm_result ) Replication Example This example matches Interlibrary Relationship Frequencies on PDF page 169 of the User’s Guide: # remove closed and temporarily closed libraries results <- table( pls_df[ !( pls_df[ , 'statstru' ] %in% c( 3 , 23 ) ) , 'c_relatn' ] ) stopifnot( results[ "HQ-Headquarters of a federation or cooperative" ] == 112 ) stopifnot( results[ "ME-Member of a federation or cooperative" ] == 6859 ) stopifnot( results[ "NO-Not a member of a federation or cooperative" ] == 2236 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for PLS users, this code replicates previously-presented examples: library(dplyr) pls_tbl <- as_tibble( pls_df ) Calculate the mean (average) of a linear variable, overall and by groups: pls_tbl %>% summarize( mean = mean( popu_lsa , na.rm = TRUE ) ) pls_tbl %>% group_by( stabr ) %>% summarize( mean = mean( popu_lsa , na.rm = TRUE ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for PLS users, this code replicates previously-presented examples: library(data.table) pls_dt <- data.table( pls_df ) Calculate the mean (average) of a linear variable, overall and by groups: pls_dt[ , mean( popu_lsa , na.rm = TRUE ) ] pls_dt[ , mean( popu_lsa , na.rm = TRUE ) , by = stabr ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for PLS users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'pls' , pls_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( popu_lsa ) FROM pls' ) dbGetQuery( con , 'SELECT stabr , AVG( popu_lsa ) FROM pls GROUP BY stabr' ) "],["pesquisa-nacional-por-amostra-de-domicilios-pnad.html", "Pesquisa Nacional por Amostra de Domicilios (PNAD) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " Pesquisa Nacional por Amostra de Domicilios (PNAD) Brazil’s principal labor force survey, measuring education, employment, income, housing characteristics. One consolidated table with one row per individual within each sampled household. A complex sample survey designed to generalize to the civilian non-institutional population of Brazil. Released quarterly since 2012, with microdata available both quarterly and annually. Administered by the Instituto Brasileiro de Geografia e Estatistica. Please skim before you begin: Conceitos e métodos Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # mineiro data # love verdade gave to me # twelve karaoke.. Download, Import, Preparation Download and import the dictionary file: dictionary_tf <- tempfile() dictionary_url <- paste0( "https://ftp.ibge.gov.br/Trabalho_e_Rendimento/" , "Pesquisa_Nacional_por_Amostra_de_Domicilios_continua/" , "Trimestral/Microdados/Documentacao/Dicionario_e_input_20221031.zip" ) download.file( dictionary_url , dictionary_tf , mode = 'wb' ) dictionary_files <- unzip( dictionary_tf , exdir = tempdir() ) sas_fn <- grep( '\\\\.sas$' , dictionary_files , value = TRUE ) sas_lines <- readLines( sas_fn , encoding = 'latin1' ) Determine fixed-width file positions from the SAS import script: sas_start <- grep( '@0001' , sas_lines ) sas_end <- grep( ';' , sas_lines ) sas_end <- sas_end[ sas_end > sas_start ][ 1 ] sas_lines <- sas_lines[ seq( sas_start , sas_end - 1 ) ] # remove SAS comments sas_lines <- gsub( "\\\\/\\\\*(.*)" , "" , sas_lines ) # remove multiple spaces and spaces at the end of each string sas_lines <- gsub( "( +)" , " " , sas_lines ) sas_lines <- gsub( " $" , "" , sas_lines ) sas_df <- read.table( textConnection( sas_lines ) , sep = ' ' , col.names = c( 'position' , 'column_name' , 'length' ) , header = FALSE ) sas_df[ , 'character' ] <- grepl( '\\\\$' , sas_df[ , 'length' ] ) sas_df[ , 'position' ] <- as.integer( gsub( "\\\\@" , "" , sas_df[ , 'position' ] ) ) sas_df[ , 'length' ] <- as.integer( gsub( "\\\\$" , "" , sas_df[ , 'length' ] ) ) stopifnot( sum( sas_df[ , 'length' ] ) == ( sas_df[ nrow( sas_df ) , 'position' ] + sas_df[ nrow( sas_df ) , 'length' ] - 1 ) ) Download the latest quarterly file: this_tf <- tempfile() this_url <- paste0( "https://ftp.ibge.gov.br/Trabalho_e_Rendimento/" , "Pesquisa_Nacional_por_Amostra_de_Domicilios_continua/" , "Trimestral/Microdados/2023/PNADC_012023.zip" ) download.file( this_url , this_tf , mode = 'wb' ) Import the latest quarterly file: library(readr) pnad_tbl <- read_fwf( this_tf , fwf_widths( widths = sas_df[ , 'length' ] , col_names = sas_df[ , 'column_name' ] ) , col_types = paste0( ifelse( sas_df[ , 'character' ] , "c" , "d" ) , collapse = '' ) ) pnad_df <- data.frame( pnad_tbl ) names( pnad_df ) <- tolower( names( pnad_df ) ) pnad_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # pnad_fn <- file.path( path.expand( "~" ) , "PNAD" , "this_file.rds" ) # saveRDS( pnad_df , file = pnad_fn , compress = FALSE ) Load the same object: # pnad_df <- readRDS( pnad_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) pnad_design <- svrepdesign( data = pnad_df , weight = ~ v1028 , type = 'bootstrap' , repweights = 'v1028[0-9]+' , mse = TRUE , ) Variable Recoding Add new columns to the data set: pnad_design <- update( pnad_design , pia = as.numeric( v2009 >= 14 ) ) pnad_design <- update( pnad_design , ocup_c = ifelse( pia == 1 , as.numeric( vd4002 %in% 1 ) , NA ) , desocup30 = ifelse( pia == 1 , as.numeric( vd4002 %in% 2 ) , NA ) ) pnad_design <- update( pnad_design , uf_name = factor( as.numeric( uf ) , levels = c(11L, 12L, 13L, 14L, 15L, 16L, 17L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 31L, 32L, 33L, 35L, 41L, 42L, 43L, 50L, 51L, 52L, 53L) , labels = c("Rondonia", "Acre", "Amazonas", "Roraima", "Para", "Amapa", "Tocantins", "Maranhao", "Piaui", "Ceara", "Rio Grande do Norte", "Paraiba", "Pernambuco", "Alagoas", "Sergipe", "Bahia", "Minas Gerais", "Espirito Santo", "Rio de Janeiro", "Sao Paulo", "Parana", "Santa Catarina", "Rio Grande do Sul", "Mato Grosso do Sul", "Mato Grosso", "Goias", "Distrito Federal") ) , age_categories = factor( 1 + findInterval( v2009 , seq( 5 , 60 , 5 ) ) ) , male = as.numeric( v2007 == 1 ) , region = substr( uf , 1 , 1 ) , # calculate usual income from main job # (rendimento habitual do trabalho principal) vd4016n = ifelse( pia %in% 1 & vd4015 %in% 1 , vd4016 , NA ) , # calculate effective income from main job # (rendimento efetivo do trabalho principal) vd4017n = ifelse( pia %in% 1 & vd4015 %in% 1 , vd4017 , NA ) , # calculate usual income from all jobs # (variavel rendimento habitual de todos os trabalhos) vd4019n = ifelse( pia %in% 1 & vd4015 %in% 1 , vd4019 , NA ) , # calculate effective income from all jobs # (rendimento efetivo do todos os trabalhos) vd4020n = ifelse( pia %in% 1 & vd4015 %in% 1 , vd4020 , NA ) , # determine the potential labor force pea_c = as.numeric( ocup_c == 1 | desocup30 == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( pnad_design , "sampling" ) != 0 ) svyby( ~ one , ~ uf_name , pnad_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , pnad_design ) svyby( ~ one , ~ uf_name , pnad_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ vd4020n , pnad_design , na.rm = TRUE ) svyby( ~ vd4020n , ~ uf_name , pnad_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ age_categories , pnad_design ) svyby( ~ age_categories , ~ uf_name , pnad_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ vd4020n , pnad_design , na.rm = TRUE ) svyby( ~ vd4020n , ~ uf_name , pnad_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ age_categories , pnad_design ) svyby( ~ age_categories , ~ uf_name , pnad_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ vd4020n , pnad_design , 0.5 , na.rm = TRUE ) svyby( ~ vd4020n , ~ uf_name , pnad_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ ocup_c , denominator = ~ pea_c , pnad_design , na.rm = TRUE ) Subsetting Restrict the survey design to employed persons: sub_pnad_design <- subset( pnad_design , ocup_c == 1 ) Calculate the mean (average) of this subset: svymean( ~ vd4020n , sub_pnad_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ vd4020n , pnad_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ vd4020n , ~ uf_name , pnad_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( pnad_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ vd4020n , pnad_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ vd4020n , pnad_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ vd4020n , pnad_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ male , pnad_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( vd4020n ~ male , pnad_design ) Perform a chi-squared test of association for survey data: svychisq( ~ male + age_categories , pnad_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( vd4020n ~ male + age_categories , pnad_design ) summary( glm_result ) Replication Example This example matches statistics and coefficients of variation from Tabela 4092 - Pessoas de 14 anos ou mais de idade, por condição em relação à força de trabalho e condição de ocupação: nationwide_adult_population <- svytotal( ~ pia , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_adult_population ) / 1000000 , 3 ) == 174.228 ) stopifnot( round( cv( nationwide_adult_population ) / 1000000 , 3 ) == 0 ) nationwide_labor_force <- svytotal( ~ pea_c , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_labor_force ) / 1000000 , 3 ) == 107.257 ) stopifnot( round( cv( nationwide_labor_force ) * 100 , 1 ) == 0.2 ) nationwide_employed <- svytotal( ~ ocup_c , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_employed ) / 1000000 , 3 ) == 97.825 ) stopifnot( round( cv( nationwide_employed ) * 100 , 1 ) == 0.2 ) nationwide_unemployed <- svytotal( ~ desocup30 , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_unemployed ) / 1000000 , 3 ) == 9.432 ) stopifnot( round( cv( nationwide_unemployed ) * 100 , 1 ) == 1.2 ) nationwide_not_in_labor_force <- svytotal( ~ as.numeric( pia & !pea_c ) , pnad_design , na.rm = TRUE ) stopifnot( round( coef( nationwide_not_in_labor_force ) / 1000000 , 3 ) == 66.972 ) stopifnot( round( cv( nationwide_not_in_labor_force ) * 100 , 1 ) == 0.3 ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for PNAD users, this code calculates the gini coefficient on complex sample survey data: library(convey) pnad_design <- convey_prep( pnad_design ) svygini( ~ vd4020n , pnad_design , na.rm = TRUE ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for PNAD users, this code replicates previously-presented examples: library(srvyr) pnad_srvyr_design <- as_survey( pnad_design ) Calculate the mean (average) of a linear variable, overall and by groups: pnad_srvyr_design %>% summarize( mean = survey_mean( vd4020n , na.rm = TRUE ) ) pnad_srvyr_design %>% group_by( uf_name ) %>% summarize( mean = survey_mean( vd4020n , na.rm = TRUE ) ) "],["pesquisa-nacional-de-saude-pns.html", "Pesquisa Nacional de Saude (PNS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Pesquisa Nacional de Saude (PNS) Brazil’s health survey, measuring medical conditions, risk behaviors, access to and use of care. One consolidated table with one row per individual within each sampled household. A complex sample survey designed to generalize to Brazil’s civilian population. Released at approximately five year intervals starting in 2013. Administered by Instituto Brasileiro de Geografia e Estatistica partnered with the Ministério da Saúde. Please skim before you begin: Conceitos e métodos Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # cheer the ministry! # with each caipirinha, or # fail sex life module Download, Import, Preparation Download and import the dictionary file: dictionary_tf <- tempfile() dictionary_url <- "https://ftp.ibge.gov.br/PNS/2019/Microdados/Documentacao/Dicionario_e_input_20220530.zip" download.file( dictionary_url , dictionary_tf , mode = 'wb' ) dictionary_files <- unzip( dictionary_tf , exdir = tempdir() ) sas_fn <- grep( '\\\\.sas$' , dictionary_files , value = TRUE ) sas_lines <- readLines( sas_fn , encoding = 'latin1' ) Determine fixed-width file positions from the SAS import script: sas_start <- grep( '@00001' , sas_lines ) sas_end <- grep( ';' , sas_lines ) sas_end <- sas_end[ sas_end > sas_start ][ 1 ] sas_lines <- sas_lines[ seq( sas_start , sas_end - 1 ) ] # remove SAS comments sas_lines <- gsub( "\\\\/\\\\*(.*)" , "" , sas_lines ) # remove tabs, multiple spaces and spaces at the end of each string sas_lines <- gsub( "\\t" , " " , sas_lines ) sas_lines <- gsub( "( +)" , " " , sas_lines ) sas_lines <- gsub( " $" , "" , sas_lines ) sas_df <- read.table( textConnection( sas_lines ) , sep = ' ' , col.names = c( 'position' , 'column_name' , 'length' ) , header = FALSE ) sas_df[ , 'character' ] <- grepl( '\\\\$' , sas_df[ , 'length' ] ) sas_df[ , 'position' ] <- as.integer( gsub( "\\\\@" , "" , sas_df[ , 'position' ] ) ) sas_df[ , 'length' ] <- as.integer( gsub( "\\\\$" , "" , sas_df[ , 'length' ] ) ) stopifnot( sum( sas_df[ , 'length' ] ) == ( sas_df[ nrow( sas_df ) , 'position' ] + sas_df[ nrow( sas_df ) , 'length' ] - 1 ) ) Download the latest data file: this_tf <- tempfile() this_url <- "https://ftp.ibge.gov.br/PNS/2019/Microdados/Dados/PNS_2019_20220525.zip" download.file( this_url , this_tf , mode = 'wb' ) Import the latest data file: library(readr) pns_tbl <- read_fwf( this_tf , fwf_widths( widths = sas_df[ , 'length' ] , col_names = sas_df[ , 'column_name' ] ) , col_types = paste0( ifelse( sas_df[ , 'character' ] , "c" , "d" ) , collapse = '' ) ) pns_df <- data.frame( pns_tbl ) names( pns_df ) <- tolower( names( pns_df ) ) pns_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # pns_fn <- file.path( path.expand( "~" ) , "PNS" , "this_file.rds" ) # saveRDS( pns_df , file = pns_fn , compress = FALSE ) Load the same object: # pns_df <- readRDS( pns_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) pns_prestratified_design <- svydesign( id = ~ upa_pns , strata = ~v0024 , data = subset( pns_df , !is.na( v0028 ) ) , weights = ~v0028 , nest = TRUE ) popc.types <- data.frame( v00283 = as.character( unique( pns_df[ , 'v00283' ] ) ) , Freq = as.numeric( unique( pns_df[ , 'v00282' ] ) ) ) popc.types <- popc.types[ order( popc.types[ , 'v00283' ] ) , ] pns_design <- postStratify( pns_prestratified_design , strata = ~v00283 , population = popc.types ) Variable Recoding Add new columns to the data set: pns_design <- update( pns_design , medical_insurance = ifelse( i00102 %in% 1:2 , as.numeric( i00102 == 1 ) , NA ) , uf_name = factor( as.numeric( v0001 ) , levels = c(11L, 12L, 13L, 14L, 15L, 16L, 17L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 31L, 32L, 33L, 35L, 41L, 42L, 43L, 50L, 51L, 52L, 53L) , labels = c("Rondonia", "Acre", "Amazonas", "Roraima", "Para", "Amapa", "Tocantins", "Maranhao", "Piaui", "Ceara", "Rio Grande do Norte", "Paraiba", "Pernambuco", "Alagoas", "Sergipe", "Bahia", "Minas Gerais", "Espirito Santo", "Rio de Janeiro", "Sao Paulo", "Parana", "Santa Catarina", "Rio Grande do Sul", "Mato Grosso do Sul", "Mato Grosso", "Goias", "Distrito Federal") ) , age_categories = factor( 1 + findInterval( c008 , seq( 5 , 90 , 5 ) ) ) , male = as.numeric( v006 == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( pns_design , "sampling" ) != 0 ) svyby( ~ one , ~ uf_name , pns_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , pns_design ) svyby( ~ one , ~ uf_name , pns_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ e01602 , pns_design , na.rm = TRUE ) svyby( ~ e01602 , ~ uf_name , pns_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ c006 , pns_design ) svyby( ~ c006 , ~ uf_name , pns_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ e01602 , pns_design , na.rm = TRUE ) svyby( ~ e01602 , ~ uf_name , pns_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ c006 , pns_design ) svyby( ~ c006 , ~ uf_name , pns_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ e01602 , pns_design , 0.5 , na.rm = TRUE ) svyby( ~ e01602 , ~ uf_name , pns_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ p00104 , denominator = ~ p00404 , pns_design , na.rm = TRUE ) Subsetting Restrict the survey design to individuals that exercise three or more days per week: sub_pns_design <- subset( pns_design , p035 %in% 3:7 ) Calculate the mean (average) of this subset: svymean( ~ e01602 , sub_pns_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ e01602 , pns_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ e01602 , ~ uf_name , pns_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( pns_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ e01602 , pns_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ e01602 , pns_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ e01602 , pns_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ medical_insurance , pns_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( e01602 ~ medical_insurance , pns_design ) Perform a chi-squared test of association for survey data: svychisq( ~ medical_insurance + c006 , pns_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( e01602 ~ medical_insurance + c006 , pns_design ) summary( glm_result ) Replication Example This example matches Estimando totais of gross monthly income from the official PNSIBGE R package: total_renda <- svytotal( ~ e01602 , pns_design , na.rm = TRUE ) stopifnot( round( coef( total_renda ) , 0 ) == 213227874692 ) stopifnot( round( SE( total_renda ) , 0 ) == 3604489769 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for PNS users, this code replicates previously-presented examples: library(srvyr) pns_srvyr_design <- as_survey( pns_design ) Calculate the mean (average) of a linear variable, overall and by groups: pns_srvyr_design %>% summarize( mean = survey_mean( e01602 , na.rm = TRUE ) ) pns_srvyr_design %>% group_by( uf_name ) %>% summarize( mean = survey_mean( e01602 , na.rm = TRUE ) ) "],["pesquisa-de-orcamentos-familiares-pof.html", "Pesquisa de Orcamentos Familiares (POF) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " Pesquisa de Orcamentos Familiares (POF) Brazil’s household budget survey designed to guide major economic indicators like the Contas nacionais. Various tables with one record per sampled household, resident, job, expenditure. A complex sample survey designed to generalize to the civilian population of Brazil. Released at irregular intervals, 2002-2003, 2008-2009, and 2017-2018 microdata available. Administered by the Instituto Brasileiro de Geografia e Estatistica. Please skim before you begin: Pesquisa de Orçamentos Familiares 2017-2018 Perfil das despesas no Brasil Conceitos e métodos This human-composed haiku or a bouquet of artificial intelligence-generated limericks # shopping na praia # roupa, comida, pede # tres havaianas Download, Import, Preparation Download the dictionary files: library(archive) dictionary_tf <- tempfile() dictionary_url <- paste0( "https://ftp.ibge.gov.br/Orcamentos_Familiares/" , "Pesquisa_de_Orcamentos_Familiares_2017_2018/Microdados/Documentacao_20230713.zip" ) download.file( dictionary_url , dictionary_tf , mode = 'wb' ) dictionary_files <- archive_extract( dictionary_tf , dir = tempdir() ) Import the household variable dictionary: library(readxl) dictionary_fn <- file.path( tempdir() , "Dicionários de váriaveis.xls" ) domicilio_dictionary_tbl <- read_excel( dictionary_fn , sheet = "Domicílio" , skip = 3 ) domicilio_dictionary_df <- data.frame( domicilio_dictionary_tbl ) names( domicilio_dictionary_df ) <- c( 'position' , 'length' , 'decimals' , 'column_name' , 'description' , 'variable_labels' ) domicilio_dictionary_df[ c( 'position' , 'length' , 'decimals' ) ] <- sapply( domicilio_dictionary_df[ c( 'position' , 'length' , 'decimals' ) ] , as.integer ) domicilio_dictionary_df <- subset( domicilio_dictionary_df , !is.na( position ) ) Import the resident variable dictionary: morador_dictionary_tbl <- read_excel( dictionary_fn , sheet = "Morador" , skip = 3 ) morador_dictionary_df <- data.frame( morador_dictionary_tbl ) names( morador_dictionary_df ) <- c( 'position' , 'length' , 'decimals' , 'column_name' , 'description' , 'variable_labels' ) morador_dictionary_df[ c( 'position' , 'length' , 'decimals' ) ] <- sapply( morador_dictionary_df[ c( 'position' , 'length' , 'decimals' ) ] , as.integer ) morador_dictionary_df <- subset( morador_dictionary_df , !is.na( position ) ) Import the post-stratification totals: post_stratification_fn <- file.path( tempdir() , "Pos_estratos_totais.xlsx" ) post_stratification_tbl <- read_excel( post_stratification_fn , skip = 5 ) post_stratification_df <- data.frame( post_stratification_tbl ) names( post_stratification_df ) <- c( 'estrato_pof' , 'pos_estrato' , 'total_pessoas' , 'uf' , 'cod_upa' ) Download the full dataset: this_tf <- tempfile() this_url <- paste0( "https://ftp.ibge.gov.br/Orcamentos_Familiares/" , "Pesquisa_de_Orcamentos_Familiares_2017_2018/Microdados/Dados_20230713.zip" ) download.file( this_url , this_tf , mode = 'wb' ) unzipped_files <- unzip( this_tf , exdir = tempdir() ) Import the household table: library(readr) domicilio_fn <- grep( 'DOMICILIO\\\\.txt$' , unzipped_files , value = TRUE ) domicilio_tbl <- read_fwf( domicilio_fn , fwf_widths( widths = domicilio_dictionary_df[ , 'length' ] , col_names = domicilio_dictionary_df[ , 'column_name' ] ) ) domicilio_df <- data.frame( domicilio_tbl ) names( domicilio_df ) <- tolower( names( domicilio_df ) ) Import the resident table: morador_fn <- grep( 'MORADOR\\\\.txt$' , unzipped_files , value = TRUE ) morador_tbl <- read_fwf( morador_fn , fwf_widths( widths = morador_dictionary_df[ , 'length' ] , col_names = morador_dictionary_df[ , 'column_name' ] ) ) morador_df <- data.frame( morador_tbl ) names( morador_df ) <- tolower( names( morador_df ) ) Merge one household-level variable and also the post-stratification info onto the person-level table: dom_mor_df <- merge( domicilio_df[ c( 'cod_upa' , 'num_dom' , 'v6199' ) ] , morador_df ) pof_df <- merge( dom_mor_df , post_stratification_df ) stopifnot( nrow( pof_df ) == nrow( morador_df ) ) Save locally   Save the object at any point: # pof_fn <- file.path( path.expand( "~" ) , "POF" , "this_file.rds" ) # saveRDS( pof_df , file = pof_fn , compress = FALSE ) Load the same object: # pof_df <- readRDS( pof_fn ) Survey Design Definition Construct a complex sample survey design: options( survey.lonely.psu = "adjust" ) library(survey) pre_stratified_design <- svydesign( id = ~ cod_upa , strata = ~ estrato_pof , weights = ~ peso , data = pof_df , nest = TRUE ) population_totals <- aggregate( peso_final ~ pos_estrato , data = pof_df , sum ) names( population_totals ) <- c( 'pos_estrato' , 'Freq' ) pof_design <- postStratify( pre_stratified_design , ~ pos_estrato , population_totals ) Variable Recoding Add new columns to the data set: pof_design <- update( pof_design , one = 1 , food_security = factor( v6199 , levels = 1:4 , labels = c( 'food secure' , 'mild' , 'moderate' , 'severe' ) ) , age_categories = factor( 1 + findInterval( v0403 , c( 20 , 25 , 30 , 35 , 45 , 55 , 65 , 75 ) ) , levels = 1:9 , labels = c( "under 20" , "20-24" , "25-29" , "30-34" , "35-44" , "45-54" , "55-64" , "65-74" , "75+" ) ) , sex = factor( v0404 , levels = 1:2 , labels = c( 'male' , 'female' ) ) , urban = as.numeric( tipo_situacao_reg == 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( pof_design , "sampling" ) != 0 ) svyby( ~ one , ~ sex , pof_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , pof_design ) svyby( ~ one , ~ sex , pof_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ renda_total , pof_design ) svyby( ~ renda_total , ~ sex , pof_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ age_categories , pof_design ) svyby( ~ age_categories , ~ sex , pof_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ renda_total , pof_design ) svyby( ~ renda_total , ~ sex , pof_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ age_categories , pof_design ) svyby( ~ age_categories , ~ sex , pof_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ renda_total , pof_design , 0.5 ) svyby( ~ renda_total , ~ sex , pof_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ renda_total , denominator = ~ anos_estudo , pof_design , na.rm = TRUE ) Subsetting Restrict the survey design to credit card holders: sub_pof_design <- subset( pof_design , v0409 > 0 ) Calculate the mean (average) of this subset: svymean( ~ renda_total , sub_pof_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ renda_total , pof_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ renda_total , ~ sex , pof_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( pof_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ renda_total , pof_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ renda_total , pof_design , deff = TRUE ) # SRS with replacement svymean( ~ renda_total , pof_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ urban , pof_design , method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( renda_total ~ urban , pof_design ) Perform a chi-squared test of association for survey data: svychisq( ~ urban + age_categories , pof_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( renda_total ~ urban + age_categories , pof_design ) summary( glm_result ) Replication Example This example matches the 2017-2018 person-level food security estimates from Tabela 3: person_level_food_security <- svymean( ~ food_security , pof_design , na.rm = TRUE ) stopifnot( all.equal( round( coef( person_level_food_security ) , 2 ) , c( 0.59 , 0.27 , 0.09 , 0.05 ) , check.attributes = FALSE ) ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for POF users, this code calculates the gini coefficient on complex sample survey data: library(convey) pof_design <- convey_prep( pof_design ) svygini( ~ renda_total , pof_design , na.rm = TRUE ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for POF users, this code replicates previously-presented examples: library(srvyr) pof_srvyr_design <- as_survey( pof_design ) Calculate the mean (average) of a linear variable, overall and by groups: pof_srvyr_design %>% summarize( mean = survey_mean( renda_total ) ) pof_srvyr_design %>% group_by( sex ) %>% summarize( mean = survey_mean( renda_total ) ) "],["residential-energy-consumption-survey-recs.html", "Residential Energy Consumption Survey (RECS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Residential Energy Consumption Survey (RECS) A periodic study conducted to provide detailed information about energy usage in U.S. homes. One table with one row per sampled housing unit. A complex sample survey designed to generalize to U.S. homes occupied as primary residences. Released approximately every five years since 1979. Prepared by the Energy Information Administration, with help from IMG-Crown and RTI International. Please skim before you begin: Annual Energy Outlook 2023 Household Characteristics Technical Documentation Summary This human-composed haiku or a bouquet of artificial intelligence-generated limericks # housing code dogma # even satan ceased sweat since # eighth sin: central air Download, Import, Preparation Download and import the most recent sas file: library(haven) sas_tf <- tempfile() sas_url <- "https://www.eia.gov/consumption/residential/data/2020/sas/recs2020_public_v2.zip" download.file( sas_url , sas_tf , mode = 'wb' ) recs_tbl <- read_sas( sas_tf ) recs_df <- data.frame( recs_tbl ) names( recs_df ) <- tolower( names( recs_df ) ) recs_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # recs_fn <- file.path( path.expand( "~" ) , "RECS" , "this_file.rds" ) # saveRDS( recs_df , file = recs_fn , compress = FALSE ) Load the same object: # recs_df <- readRDS( recs_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) recs_design <- svrepdesign( data = recs_df , weight = ~ nweight , repweights = 'nweight[1-9]+' , type = 'JK1' , combined.weights = TRUE , scale = 59 / 60 , mse = TRUE ) Variable Recoding Add new columns to the data set: recs_design <- update( recs_design , main_heating_fuel = factor( fuelheat , levels = c( -2 , 5 , 1 , 2 , 3 , 7 , 99 ) , labels = c( 'Not applicable' , 'Electricity' , 'Natural gas from underground pipes' , 'Propane (bottled gas)' , 'Fuel oil' , 'Wood or pellets' , 'Other' ) ) , rooftype = factor( rooftype , levels = c( -2 , 1:6 , 99 ) , labels = c( 'Not applicable' , 'Ceramic or clay tiles' , 'Wood shingles/shakes' , 'Metal' , 'Slate or synthetic slate' , 'Shingles (composition or asphalt)' , 'Concrete tiles' , 'Other' ) ) , swimpool_binary = ifelse( swimpool %in% 0:1 , swimpool , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( recs_design , "sampling" ) != 0 ) svyby( ~ one , ~ main_heating_fuel , recs_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , recs_design ) svyby( ~ one , ~ main_heating_fuel , recs_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ totsqft_en , recs_design ) svyby( ~ totsqft_en , ~ main_heating_fuel , recs_design , svymean ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ rooftype , recs_design ) svyby( ~ rooftype , ~ main_heating_fuel , recs_design , svymean ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ totsqft_en , recs_design ) svyby( ~ totsqft_en , ~ main_heating_fuel , recs_design , svytotal ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ rooftype , recs_design ) svyby( ~ rooftype , ~ main_heating_fuel , recs_design , svytotal ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ totsqft_en , recs_design , 0.5 ) svyby( ~ totsqft_en , ~ main_heating_fuel , recs_design , svyquantile , 0.5 , ci = TRUE ) Estimate a ratio: svyratio( numerator = ~ totcsqft , denominator = ~ totsqft_en , recs_design ) Subsetting Restrict the survey design to households that cook three or more hot meals per day: sub_recs_design <- subset( recs_design , nummeal == 1 ) Calculate the mean (average) of this subset: svymean( ~ totsqft_en , sub_recs_design ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ totsqft_en , recs_design ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ totsqft_en , ~ main_heating_fuel , recs_design , svymean ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( recs_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ totsqft_en , recs_design ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ totsqft_en , recs_design , deff = TRUE ) # SRS with replacement svymean( ~ totsqft_en , recs_design , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ swimpool_binary , recs_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( totsqft_en ~ swimpool_binary , recs_design ) Perform a chi-squared test of association for survey data: svychisq( ~ swimpool_binary + rooftype , recs_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( totsqft_en ~ swimpool_binary + rooftype , recs_design ) summary( glm_result ) Replication Example This example matches the statistic, standard error, and relative standard error shown on PDF page 8 of Using the microdata file to compute estimates and relative standard errors (RSEs) sas_v1_tf <- tempfile() sas_v1_url <- "https://www.eia.gov/consumption/residential/data/2020/sas/recs2020_public_v1.zip" download.file( sas_v1_url , sas_v1_tf , mode = 'wb' ) recs_v1_tbl <- read_sas( sas_v1_tf ) recs_v1_df <- data.frame( recs_v1_tbl ) names( recs_v1_df ) <- tolower( names( recs_v1_df ) ) recs_v1_design <- svrepdesign( data = recs_v1_df , weight = ~ nweight , repweights = 'nweight[1-9]+' , type = 'JK1' , combined.weights = TRUE , scale = 59 / 60 , mse = TRUE ) recs_v1_design <- update( recs_v1_design , natural_gas_mainspace_heat = as.numeric( fuelheat == 1 ) ) result <- svytotal( ~ natural_gas_mainspace_heat , recs_v1_design ) stopifnot( round( coef( result ) , 0 ) == 56245389 ) stopifnot( round( SE( result ) , 0 ) == 545591 ) stopifnot( round( 100 * SE( result ) / coef( result ) , 2 ) == 0.97 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for RECS users, this code replicates previously-presented examples: library(srvyr) recs_srvyr_design <- as_survey( recs_design ) Calculate the mean (average) of a linear variable, overall and by groups: recs_srvyr_design %>% summarize( mean = survey_mean( totsqft_en ) ) recs_srvyr_design %>% group_by( main_heating_fuel ) %>% summarize( mean = survey_mean( totsqft_en ) ) "],["survey-of-business-owners-sbo.html", "Survey of Business Owners (SBO) Function Definitions Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Survey of Business Owners (SBO) Before its replacement in 2018 by the Annual Business Survey, nearly every tax-filing sole proprietorship, partnership, and corporation nationwide completed this questionnaire, with 2007 the only microdata year. One table with one row per firm per state per industry, except eight collapsed geographies. A complex sample survey designed to generalize to most firms in the United States, public microdata includes classifiable (non-identifiable) firms, i.e. nearly all businesses but only about half of workers. Released quinquennially from 1972 until 2012 in the Economic Census with no updates expected. Administered by the U.S. Census Bureau. Annual Business Survey now conducted jointly with the National Center for Science and Engineering Statistics within the National Science Foundation. Please skim before you begin: 2007 Survey of Business Owners (SBO) Public Use Microdata Sample (PUMS) Data Users Guide Comparability to the Annual Business Survey (ABS), the Nonemployer Statistics by Demographics (NES-D) series, and the Annual Survey of Entrepreneurs (ASE) At a Glance This human-composed haiku or a bouquet of artificial intelligence-generated limericks # butchers, chandlers, baked # sea shanty, filial pie # call your mom and pop Function Definitions This survey uses a dual design variance estimation technique described in the Data Users Guide. Most users do not need to study these functions carefully. Define functions specific to only this dataset: sbo_MIcombine <- function( x , adjustment = 1.992065 ){ # pull the structure of a variance-covariance matrix variance.shell <- suppressWarnings( vcov( x$var[[1]] ) ) # initiate a function that will overwrite the diagonals. diag.replacement <- function( z ){ diag( variance.shell ) <- coef( z ) variance.shell } # overwrite all the diagonals in the variance this_design object coef.variances <- lapply( x$var , diag.replacement ) # add then divide by ten midpoint <- Reduce( '+' , coef.variances ) / 10 # initiate another function that takes some object, # subtracts the midpoint, squares it, divides by ninety midpoint.var <- function( z ){ 1/10 * ( ( midpoint - z )^2 / 9 ) } # sum up all the differences into a single object variance <- Reduce( '+' , lapply( coef.variances , midpoint.var ) ) # adjust every number with the factor in the user guide adj_var <- adjustment * variance # construct a result that looks like other sbo_MIcombine methods rval <- list( coefficients = coef( x$coef ) , variance = adj_var ) # call it an MIresult class, like other sbo_MIcombine results class( rval ) <- 'MIresult' rval } sbo_with <- function ( this_design , expr , ... ){ pf <- parent.frame() expr <- substitute( expr ) expr$design <- as.name(".design") # this pulls in means, medians, totals, etc. # notice it uses this_design$coef results <- eval( expr , list( .design = this_design$coef ) ) # this is used to calculate the variance, adjusted variance, standard error # notice it uses the this_design$var object variances <- lapply( this_design$var$designs , function( .design ){ eval( expr , list( .design = .design ) , enclos = pf ) } ) # combine both results.. rval <- list( coef = results , var = variances ) # ..into a brand new object class class( rval ) <- 'imputationResultList' rval } sbo_subset <- function( x , ... ){ # subset the survey object coef.sub <- subset( x$coef , ... ) # replicate `var.sub` so it's got all the same attributes as `x$var` var.sub <- x$var # but then overwrite the `designs` attribute with a subset var.sub$designs <- lapply( x$var$designs , subset , ... ) # now re-create the `sbosvyimputationList` just as before.. sub.svy <- list( coef = coef.sub , var = var.sub ) # ..and give it the same class sub.svy$call <- sys.call(-1) sub.svy } sbo_update <- function( x , ... ){ # update the survey object that's going to be used for # means, medians, totals, etc. coef.upd <- update( x$coef , ... ) # replicate `var.upd` so it's got all the same attributes as `x$var` var.upd <- x$var # but then overwrite the `designs` attribute with an update var.upd$designs <- lapply( x$var$designs , update , ... ) # now re-create the `sbosvyimputationList` just as before upd.svy <- list( coef = coef.upd , var = var.upd ) upd.svy } sbo_degf <- function( x ) degf( x$coef ) Download, Import, Preparation Download and import the file containing records for both coefficient estimates and variance estimation: library(httr) library(readr) tf <- tempfile() this_url <- "https://www2.census.gov/programs-surveys/sbo/datasets/2007/pums_csv.zip" GET( this_url , write_disk( tf ) , progress() ) sbo_tbl <- read_csv( tf ) sbo_df <- data.frame( sbo_tbl ) names( sbo_df ) <- tolower( names( sbo_df ) ) sbo_df[ , 'one' ] <- 1 Calculate the weights used for variance estimation: sbo_df[ , 'newwgt' ] <- 10 * sbo_df[ , 'tabwgt' ] * sqrt( 1 - 1 / sbo_df[ , 'tabwgt' ] ) Add business ownership percentages for both gender and ethnicity: # replace percent missings with zeroes for( i in 1:4 ) sbo_df[ is.na( sbo_df[ , paste0( 'pct' , i ) ] ) , paste0( 'pct' , i ) ] <- 0 # sum up ownership ethnicity and gender sbo_df[ , 'hispanic_pct' ] <- sbo_df[ , 'nonhispanic_pct' ] <- 0 sbo_df[ , 'male_pct' ] <- sbo_df[ , 'female_pct' ] <- 0 # loop through the first four owners' ethnicity and sex variables for( i in 1:4 ) { sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'H' , 'hispanic_pct' ] <- sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'H' , 'hispanic_pct' ] + sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'H' , paste0( 'pct' , i ) ] sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'N' , 'nonhispanic_pct' ] <- sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'N' , 'nonhispanic_pct' ] + sbo_df[ sbo_df[ , paste0( 'eth' , i ) ] %in% 'N' , paste0( 'pct' , i ) ] sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'M' , 'male_pct' ] <- sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'M' , 'male_pct' ] + sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'M' , paste0( 'pct' , i ) ] sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'F' , 'female_pct' ] <- sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'F' , 'female_pct' ] + sbo_df[ sbo_df[ , paste0( 'sex' , i ) ] %in% 'F' , paste0( 'pct' , i ) ] } Save locally   Save the object at any point: # sbo_fn <- file.path( path.expand( "~" ) , "SBO" , "this_file.rds" ) # saveRDS( sbo_df , file = sbo_fn , compress = FALSE ) Load the same object: # sbo_df <- readRDS( sbo_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: library(survey) library(mitools) # break random groups into ten separate data.frame objects within a list var_list <- NULL for( i in 1:10 ) { var_list <- c( var_list , list( subset( sbo_df , rg == i ) ) ) } sbo_coef <- svydesign( id = ~ 1 , weight = ~ tabwgt , data = sbo_df ) sbo_var <- svydesign( id = ~ 1 , weight = ~ newwgt , data = imputationList( var_list ) ) sbo_design <- list( coef = sbo_coef , var = sbo_var ) class( sbo_design ) <- 'sbosvyimputationList' Variable Recoding Add new columns to the data set: sbo_design <- sbo_update( sbo_design , established_before_2000 = ifelse( established %in% c( '0' , 'A' ) , NA , as.numeric( established < 4 ) ) , healthins = factor( healthins , levels = 1:2 , labels = c( "offered health insurance" , "did not offer health insurance" ) ) , hispanic_ownership = factor( ifelse( hispanic_pct == nonhispanic_pct , 2 , ifelse( hispanic_pct > nonhispanic_pct , 1 , ifelse( nonhispanic_pct > hispanic_pct , 3 , NA ) ) ) , levels = 1:3 , labels = c( 'hispanic' , 'equally hisp/non' , 'non-hispanic' ) ) , gender_ownership = factor( ifelse( male_pct == female_pct , 2 , ifelse( male_pct > female_pct , 1 , ifelse( female_pct > male_pct , 3 , NA ) ) ) , levels = 1:3 , labels = c( 'male' , 'equally male/female' , 'female' ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svyby( ~ one , ~ one , unwtd.count ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ one , ~ gender_ownership , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svytotal( ~ one ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ one , ~ gender_ownership , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svymean( ~ receipts_noisy ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ gender_ownership , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svymean( ~ n07_employer , na.rm = TRUE ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ n07_employer , ~ gender_ownership , svymean , na.rm = TRUE ) ) ) Calculate the sum of a linear variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svytotal( ~ receipts_noisy ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ gender_ownership , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svytotal( ~ n07_employer , na.rm = TRUE ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ n07_employer , ~ gender_ownership , svytotal , na.rm = TRUE ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: sbo_MIcombine( sbo_with( sbo_design , svyquantile( ~ receipts_noisy , 0.5 , se = TRUE ) ) ) sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ gender_ownership , svyquantile , 0.5 , se = TRUE , ci = TRUE ) ) ) Estimate a ratio: sbo_MIcombine( sbo_with( sbo_design , svyratio( numerator = ~ receipts_noisy , denominator = ~ employment_noisy ) ) ) Subsetting Restrict the survey design to jointly owned by husband and wife: sub_sbo_design <- sbo_subset( sbo_design , husbwife %in% 1:3 ) Calculate the mean (average) of this subset: sbo_MIcombine( sbo_with( sub_sbo_design , svymean( ~ receipts_noisy ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- sbo_MIcombine( sbo_with( sbo_design , svymean( ~ receipts_noisy ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ gender_ownership , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: sbo_degf( sbo_design ) Calculate the complex sample survey-adjusted variance of any statistic: sbo_MIcombine( sbo_with( sbo_design , svyvar( ~ receipts_noisy ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement sbo_MIcombine( sbo_with( sbo_design , svymean( ~ receipts_noisy , deff = TRUE ) ) ) # SRS with replacement sbo_MIcombine( sbo_with( sbo_design , svymean( ~ receipts_noisy , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # # sbo_MIsvyciprop( ~ established_before_2000 , sbo_design , # method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: # # sbo_MIsvyttest( receipts_noisy ~ established_before_2000 , sbo_design ) Perform a chi-squared test of association for survey data: # # sbo_MIsvychisq( ~ established_before_2000 + n07_employer , sbo_design ) Perform a survey-weighted generalized linear model: glm_result <- sbo_MIcombine( sbo_with( sbo_design , svyglm( receipts_noisy ~ established_before_2000 + n07_employer ) ) ) glm_result Replication Example This example matches the statistics and relative standard errors from three Appendix B columns: hispanic_receipts_result <- sbo_MIcombine( sbo_with( sbo_design , svyby( ~ receipts_noisy , ~ hispanic_ownership , svytotal ) ) ) hispanic_payroll_result <- sbo_MIcombine( sbo_with( sbo_design , svyby( ~ payroll_noisy , ~ hispanic_ownership , svytotal ) ) ) hispanic_employment_result <- sbo_MIcombine( sbo_with( sbo_design , svyby( ~ employment_noisy , ~ hispanic_ownership , svytotal ) ) ) Estimates at the U.S. Level using the PUMS Tables for: stopifnot( round( coef( hispanic_receipts_result )[ 'hispanic' ] , 0 ) == 350763923 ) stopifnot( round( coef( hispanic_receipts_result )[ 'equally hisp/non' ] , 0 ) == 56166354 ) stopifnot( round( coef( hispanic_receipts_result )[ 'non-hispanic' ] , 0 ) == 10540609303 ) stopifnot( round( coef( hispanic_payroll_result )[ 'hispanic' ] , 0 ) == 54367702 ) stopifnot( round( coef( hispanic_payroll_result )[ 'equally hisp/non' ] , 0 ) == 11083148 ) stopifnot( round( coef( hispanic_payroll_result )[ 'non-hispanic' ] , 0 ) == 1875353228 ) stopifnot( round( coef( hispanic_employment_result )[ 'hispanic' ] , 0 ) == 2026406 ) stopifnot( round( coef( hispanic_employment_result )[ 'equally hisp/non' ] , 0 ) == 400152 ) stopifnot( round( coef( hispanic_employment_result )[ 'non-hispanic' ] , 0 ) == 56889606 ) Relative Standard Errors of Estimates at the U.S. Level using the PUMS Tables for: stopifnot( round( cv( hispanic_receipts_result )[ 'hispanic' ] , 2 ) == 0.02 ) stopifnot( round( cv( hispanic_receipts_result )[ 'equally hisp/non' ] , 2 ) == 0.06 ) stopifnot( round( cv( hispanic_receipts_result )[ 'non-hispanic' ] , 2 ) == 0 ) stopifnot( round( cv( hispanic_payroll_result )[ 'hispanic' ] , 2 ) == 0.01 ) stopifnot( round( cv( hispanic_payroll_result )[ 'equally hisp/non' ] , 2 ) == 0.06 ) stopifnot( round( cv( hispanic_payroll_result )[ 'non-hispanic' ] , 2 ) == 0 ) stopifnot( round( cv( hispanic_employment_result )[ 'hispanic' ] , 2 ) == 0.01 ) stopifnot( round( cv( hispanic_employment_result )[ 'equally hisp/non' ] , 2 ) == 0.05 ) stopifnot( round( cv( hispanic_employment_result )[ 'non-hispanic' ] , 2 ) == 0 ) "],["survey-of-consumer-finances-scf.html", "Survey of Consumer Finances (SCF) Function Definitions Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey  ", " Survey of Consumer Finances (SCF) A comprehensive survey of household wealth, the U.S. central bank studies net worth across the country by asking about both active and passive income, mortgages, pensions, credit card debt, even car leases. Five implicates, each containing one row per sampled household to account for statistical uncertainty. A complex sample survey designed to generalize to the civilian non-institutional U.S. population. Released triennially since 1989. Administered by the Board of Governors of the Federal Reserve System. Please skim before you begin: Measuring Income and Wealth at the Top Using Administrative and Survey Data Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # incomes, assets, debts # high net worth oversample # pig bank laproscope Function Definitions This survey uses a multiply-imputed variance estimation technique described in the 2004 Codebook. Most users do not need to study this function carefully. Define a function specific to only this dataset: scf_MIcombine <- function (results, variances, call = sys.call(), df.complete = Inf, ...) { m <- length(results) oldcall <- attr(results, "call") if (missing(variances)) { variances <- suppressWarnings(lapply(results, vcov)) results <- lapply(results, coef) } vbar <- variances[[1]] cbar <- results[[1]] for (i in 2:m) { cbar <- cbar + results[[i]] # MODIFICATION: # vbar <- vbar + variances[[i]] } cbar <- cbar/m # MODIFICATION: # vbar <- vbar/m evar <- var(do.call("rbind", results)) r <- (1 + 1/m) * evar/vbar df <- (m - 1) * (1 + 1/r)^2 if (is.matrix(df)) df <- diag(df) if (is.finite(df.complete)) { dfobs <- ((df.complete + 1)/(df.complete + 3)) * df.complete * vbar/(vbar + evar) if (is.matrix(dfobs)) dfobs <- diag(dfobs) df <- 1/(1/dfobs + 1/df) } if (is.matrix(r)) r <- diag(r) rval <- list(coefficients = cbar, variance = vbar + evar * (m + 1)/m, call = c(oldcall, call), nimp = m, df = df, missinfo = (r + 2/(df + 3))/(r + 1)) class(rval) <- "MIresult" rval } Download, Import, Preparation Define a function to download and import each stata file: library(haven) scf_dta_import <- function( this_url ){ this_tf <- tempfile() download.file( this_url , this_tf , mode = 'wb' ) this_tbl <- read_dta( this_tf ) this_df <- data.frame( this_tbl ) file.remove( this_tf ) names( this_df ) <- tolower( names( this_df ) ) this_df } Download and import the full, summary extract, and replicate weights tables: scf_df <- scf_dta_import( "https://www.federalreserve.gov/econres/files/scf2022s.zip" ) ext_df <- scf_dta_import( "https://www.federalreserve.gov/econres/files/scfp2022s.zip" ) scf_rw_df <- scf_dta_import( "https://www.federalreserve.gov/econres/files/scf2022rw1s.zip" ) Confirm both the full public data and the summary extract contain five records per family: stopifnot( nrow( scf_df ) == nrow( scf_rw_df ) * 5 ) stopifnot( nrow( scf_df ) == nrow( ext_df ) ) Confirm only the primary economic unit and the five implicate identifiers overlap: stopifnot( all( sort( intersect( names( scf_df ) , names( ext_df ) ) ) == c( 'y1' , 'yy1' ) ) ) stopifnot( all( sort( intersect( names( scf_df ) , names( scf_rw_df ) ) ) == c( 'y1' , 'yy1' ) ) ) stopifnot( all( sort( intersect( names( ext_df ) , names( scf_rw_df ) ) ) == c( 'y1' , 'yy1' ) ) ) Remove the implicate identifier from the replicate weights table, add a column of fives for weighting: scf_rw_df[ , 'y1' ] <- NULL scf_df[ , 'five' ] <- 5 Save locally   Save the object at any point: # scf_fn <- file.path( path.expand( "~" ) , "SCF" , "this_file.rds" ) # saveRDS( scf_df , file = scf_fn , compress = FALSE ) Load the same object: # scf_df <- readRDS( scf_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: Break the main table into five different implicates based on the final character of the column y1: library(stringr) s1_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 1 , ] s2_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 2 , ] s3_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 3 , ] s4_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 4 , ] s5_df <- scf_df[ str_sub( scf_df[ , 'y1' ] , -1 , -1 ) == 5 , ] Combine these into a single list, then merge each implicate with the summary extract: scf_imp <- list( s1_df , s2_df , s3_df , s4_df , s5_df ) scf_list <- lapply( scf_imp , merge , ext_df ) Replace all missing values in the replicate weights table with zeroes, multiply the replicate weights by the multiplication factor, then only keep the unique identifier and the final (combined) replicate weights: scf_rw_df[ is.na( scf_rw_df ) ] <- 0 scf_rw_df[ , paste0( 'wgt' , 1:999 ) ] <- scf_rw_df[ , paste0( 'wt1b' , 1:999 ) ] * scf_rw_df[ , paste0( 'mm' , 1:999 ) ] scf_rw_df <- scf_rw_df[ , c( 'yy1' , paste0( 'wgt' , 1:999 ) ) ] Sort both the five implicates and also the replicate weights table by the unique identifier: scf_list <- lapply( scf_list , function( w ) w[ order( w[ , 'yy1' ] ) , ] ) scf_rw_df <- scf_rw_df[ order( scf_rw_df[ , 'yy1' ] ) , ] Define the design: library(survey) library(mitools) scf_design <- svrepdesign( weights = ~wgt , repweights = scf_rw_df[ , -1 ] , data = imputationList( scf_list ) , scale = 1 , rscales = rep( 1 / 998 , 999 ) , mse = FALSE , type = "other" , combined.weights = TRUE ) Variable Recoding Add new columns to the data set: scf_design <- update( scf_design , hhsex = factor( hhsex , levels = 1:2 , labels = c( "male" , "female" ) ) , married = as.numeric( married == 1 ) , edcl = factor( edcl , levels = 1:4 , labels = c( "less than high school" , "high school or GED" , "some college" , "college degree" ) ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: scf_MIcombine( with( scf_design , svyby( ~ five , ~ five , unwtd.count ) ) ) scf_MIcombine( with( scf_design , svyby( ~ five , ~ hhsex , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: scf_MIcombine( with( scf_design , svytotal( ~ five ) ) ) scf_MIcombine( with( scf_design , svyby( ~ five , ~ hhsex , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: scf_MIcombine( with( scf_design , svymean( ~ networth ) ) ) scf_MIcombine( with( scf_design , svyby( ~ networth , ~ hhsex , svymean ) ) ) Calculate the distribution of a categorical variable, overall and by groups: scf_MIcombine( with( scf_design , svymean( ~ edcl ) ) ) scf_MIcombine( with( scf_design , svyby( ~ edcl , ~ hhsex , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: scf_MIcombine( with( scf_design , svytotal( ~ networth ) ) ) scf_MIcombine( with( scf_design , svyby( ~ networth , ~ hhsex , svytotal ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: scf_MIcombine( with( scf_design , svytotal( ~ edcl ) ) ) scf_MIcombine( with( scf_design , svyby( ~ edcl , ~ hhsex , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: scf_MIcombine( with( scf_design , svyquantile( ~ networth , 0.5 , se = TRUE , interval.type = 'quantile' ) ) ) scf_MIcombine( with( scf_design , svyby( ~ networth , ~ hhsex , svyquantile , 0.5 , se = TRUE , interval.type = 'quantile' , ci = TRUE ) ) ) Estimate a ratio: scf_MIcombine( with( scf_design , svyratio( numerator = ~ income , denominator = ~ networth ) ) ) Subsetting Restrict the survey design to labor force participants: sub_scf_design <- subset( scf_design , lf == 1 ) Calculate the mean (average) of this subset: scf_MIcombine( with( sub_scf_design , svymean( ~ networth ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- scf_MIcombine( with( scf_design , svymean( ~ networth ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- scf_MIcombine( with( scf_design , svyby( ~ networth , ~ hhsex , svymean ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( scf_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: scf_MIcombine( with( scf_design , svyvar( ~ networth ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement scf_MIcombine( with( scf_design , svymean( ~ networth , deff = TRUE ) ) ) # SRS with replacement scf_MIcombine( with( scf_design , svymean( ~ networth , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ married , scf_design , # method = "likelihood" ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( networth ~ married , scf_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ married + edcl , scf_design ) Perform a survey-weighted generalized linear model: glm_result <- scf_MIcombine( with( scf_design , svyglm( networth ~ married + edcl ) ) ) summary( glm_result ) Replication Example This example matches the “Table 4” tab’s cell Y6 of the Excel Based on Public Data: mean_net_worth <- scf_MIcombine( with( scf_design , svymean( ~ networth ) ) ) stopifnot( round( coef( mean_net_worth ) / 1000 , 1 ) == 1059.5 ) This example comes within $500 of the standard error of mean net worth from Table 2 of the Federal Reserve Bulletin, displaying the minor differences between the Internal Data and Public Data: stopifnot( abs( 23.2 - round( SE( mean_net_worth ) / 1000 , 1 ) ) < 0.5 ) This example matches the “Table 4” tab’s cells X6 of the Excel Based on Public Data: # compute quantile with all five implicates stacked (not the recommended technique) fake_design <- svydesign( ~ 1 , data = ext_df[ c( 'networth' , 'wgt' ) ] , weights = ~ wgt ) median_net_worth_incorrect_errors <- svyquantile( ~ networth , fake_design , 0.5 ) stopifnot( round( coef( median_net_worth_incorrect_errors ) / 1000 , 2 ) == 192.7 ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for SCF users, this code calculates the gini coefficient on complex sample survey data: library(convey) scf_design$designs <- lapply( scf_design$designs , convey_prep ) scf_MIcombine( with( scf_design , svygini( ~ networth ) ) ) "],["survey-of-income-and-program-participation-sipp.html", "Survey of Income and Program Participation (SIPP) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Poverty and Inequality Estimation with convey   Analysis Examples with srvyr  ", " Survey of Income and Program Participation (SIPP) The primary longitudinal assessment of income fluctuation, labor force participation, social programs. Annual tables with one record per month per person per sampled household, time period weights. A complex sample generalizing to the U.S. civilian non-institutionalized across varying time periods. Multi-year panels since 1980s, its current and now permanent four year rotation beginning in 2018. Administered and financed by the US Census Bureau. Please skim before you begin: 2022 Survey of Income and Program Participation Users’ Guide 2022 Data User Notes This human-composed haiku or a bouquet of artificial intelligence-generated limericks # federal programs # poverty oversample # monthly dynamics Download, Import, Preparation Determine which variables from the main table to import: variables_to_keep <- c( 'ssuid' , 'pnum' , 'monthcode' , 'spanel' , 'swave' , 'erelrpe' , 'tlivqtr' , 'wpfinwgt' , 'rmesr' , 'thcyincpov' , 'tfcyincpov' , 'tehc_st' , 'rhicovann' , 'rfpov' , 'thnetworth' , 'tftotinc' ) Download and import the latest main file: library(httr) library(data.table) main_tf <- tempfile() main_url <- paste0( "https://www2.census.gov/programs-surveys/sipp/" , "data/datasets/2022/pu2022_csv.zip" ) GET( main_url , write_disk( main_tf ) , progress() ) main_csv <- unzip( main_tf , exdir = tempdir() ) sipp_main_dt <- fread( main_csv , sep = "|" , select = toupper( variables_to_keep ) ) sipp_main_df <- data.frame( sipp_main_dt ) names( sipp_main_df ) <- tolower( names( sipp_main_df ) ) Download and import the appropriate replicate weights file: rw_tf <- tempfile() rw_url <- paste0( "https://www2.census.gov/programs-surveys/sipp/" , "data/datasets/2022/rw2022_csv.zip" ) GET( rw_url , write_disk( rw_tf ) , progress() ) rw_csv <- unzip( rw_tf , exdir = tempdir() ) sipp_rw_dt <- fread( rw_csv , sep = "|" ) sipp_rw_df <- data.frame( sipp_rw_dt ) names( sipp_rw_df ) <- tolower( names( sipp_rw_df ) ) Limit both files to December records for a point-in-time estimate, then merge: sipp_df <- merge( sipp_main_df[ sipp_main_df[ , 'monthcode' ] %in% 12 , ] , sipp_rw_df[ sipp_rw_df[ , 'monthcode' ] %in% 12 , ] , by = c( 'ssuid' , 'pnum' , 'monthcode' , 'spanel' , 'swave' ) ) stopifnot( nrow( sipp_df ) == sum( sipp_rw_df[ , 'monthcode' ] %in% 12 ) ) Save locally   Save the object at any point: # sipp_fn <- file.path( path.expand( "~" ) , "SIPP" , "this_file.rds" ) # saveRDS( sipp_df , file = sipp_fn , compress = FALSE ) Load the same object: # sipp_df <- readRDS( sipp_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) sipp_design <- svrepdesign( data = sipp_df , weights = ~ wpfinwgt , repweights = "repwgt([1-9]+)" , type = "Fay" , rho = 0.5 ) Variable Recoding Add new columns to the data set: rmesr_values <- c( "With a job entire month, worked all weeks", "With a job all month, absent from work without pay 1+ weeks, absence not due to layoff", "With a job all month, absent from work without pay 1+ weeks, absence due to layoff", "With a job at least 1 but not all weeks, no time on layoff and no time looking for work", "With a job at least 1 but not all weeks, some weeks on layoff or looking for work", "No job all month, on layoff or looking for work all weeks", "No job all month, at least one but not all weeks on layoff or looking for work", "No job all month, no time on layoff and no time looking for work" ) sipp_design <- update( sipp_design , one = 1 , employment_status = factor( rmesr , levels = 1:8 , labels = rmesr_values ) , household_below_poverty = as.numeric( thcyincpov < 1 ) , family_below_poverty = as.numeric( tfcyincpov < 1 ) , state_name = factor( as.numeric( tehc_st ) , levels = c(1L, 2L, 4L, 5L, 6L, 8L, 9L, 10L, 11L, 12L, 13L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 53L, 54L, 55L, 56L, 60L, 61L) , labels = c("Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "District of Columbia", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming", "Puerto Rico", "Foreign Country") ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( sipp_design , "sampling" ) != 0 ) svyby( ~ one , ~ state_name , sipp_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , sipp_design ) svyby( ~ one , ~ state_name , sipp_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ tftotinc , sipp_design , na.rm = TRUE ) svyby( ~ tftotinc , ~ state_name , sipp_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ employment_status , sipp_design , na.rm = TRUE ) svyby( ~ employment_status , ~ state_name , sipp_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ tftotinc , sipp_design , na.rm = TRUE ) svyby( ~ tftotinc , ~ state_name , sipp_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ employment_status , sipp_design , na.rm = TRUE ) svyby( ~ employment_status , ~ state_name , sipp_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ tftotinc , sipp_design , 0.5 , na.rm = TRUE ) svyby( ~ tftotinc , ~ state_name , sipp_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ tftotinc , denominator = ~ rfpov , sipp_design , na.rm = TRUE ) Subsetting Restrict the survey design to individuals ever covered by health insurance during the year: sub_sipp_design <- subset( sipp_design , rhicovann == 1 ) Calculate the mean (average) of this subset: svymean( ~ tftotinc , sub_sipp_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ tftotinc , sipp_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ tftotinc , ~ state_name , sipp_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( sipp_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ tftotinc , sipp_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ tftotinc , sipp_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ tftotinc , sipp_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ family_below_poverty , sipp_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( tftotinc ~ family_below_poverty , sipp_design ) Perform a chi-squared test of association for survey data: svychisq( ~ family_below_poverty + employment_status , sipp_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( tftotinc ~ family_below_poverty + employment_status , sipp_design ) summary( glm_result ) Replication Example This example matches statistics and standard errors from the Wealth and Asset Ownership for Households, by Type of Asset and Selected Characteristics: 2021: Restrict the design to permanent residence-based householders to match the count in Table 4: sipp_household_design <- subset( sipp_design , erelrpe %in% 1:2 & tlivqtr %in% 1:2 ) stopifnot( round( coef( svytotal( ~ one , sipp_household_design ) ) / 1000 , -2 ) == 132700 ) Compute Household Net Worth distribution and standard errors across the Total row of Tables 4 and 4A: sipp_household_design <- update( sipp_household_design , thnetworth_category = factor( findInterval( thnetworth , c( 1 , 5000 , 10000 , 25000 , 50000 , 100000 , 250000 , 500000 ) ) , levels = 0:8 , labels = c( "Zero or Negative" , "$1 to $4,999" , "$5,000 to $9,999" , "$10,000 to $24,999" , "$25,000 to $49,999" , "$50,000 to $99,999" , "$100,000 to $249,999" , "$250,000 to $499,999" , "$500,000 or over" ) ) ) results <- svymean( ~ thnetworth_category , sipp_household_design ) stopifnot( all.equal( as.numeric( round( coef( results ) * 100 , 1 ) ) , c( 11.3 , 6.9 , 3.5 , 5.9 , 6.4 , 8.2 , 15.3 , 13.9 , 28.7 ) ) ) stopifnot( all.equal( as.numeric( round( SE( results ) * 100 , 1 ) ) , c( 0.3 , 0.2 , 0.2 , 0.2 , 0.2 , 0.2 , 0.3 , 0.3 , 0.3 ) ) ) Poverty and Inequality Estimation with convey   The R convey library estimates measures of income concentration, poverty, inequality, and wellbeing. This textbook details the available features. As a starting point for SIPP users, this code calculates the gini coefficient on complex sample survey data: library(convey) sipp_design <- convey_prep( sipp_design ) svygini( ~ tftotinc , sipp_design , na.rm = TRUE ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for SIPP users, this code replicates previously-presented examples: library(srvyr) sipp_srvyr_design <- as_survey( sipp_design ) Calculate the mean (average) of a linear variable, overall and by groups: sipp_srvyr_design %>% summarize( mean = survey_mean( tftotinc , na.rm = TRUE ) ) sipp_srvyr_design %>% group_by( state_name ) %>% summarize( mean = survey_mean( tftotinc , na.rm = TRUE ) ) "],["social-security-public-use-data-files-ssa.html", "Social Security Public-Use Data Files (SSA) Download, Import, Preparation Analysis Examples with base R   Replication Example Analysis Examples with dplyr   Analysis Examples with data.table   Analysis Examples with duckdb  ", " Social Security Public-Use Data Files (SSA) Microdata from administrative sources like the Master Beneficiary Record, Supplemental Security Record. Tables contain either one record per person or one record per person per year. A systematic sample of either social security number holders (most americans) or program recipients (current beneficiaries). Multiply 1% samples by 100 to get weighted statistics, 5% samples by 20. No expected release timeline. Released by the Office of Research, Evaluation, and Statistics, US Social Security Administration. Please skim before you begin: The 2006 Earnings Public-Use Microdata File: An Introduction Comparing Earnings Estimates from the 2006 Public-Use File and the Annual Statistical Supplement This human-composed haiku or a bouquet of artificial intelligence-generated limericks # annual earnings. # for pensioner payouts, see # the '04 extract Download, Import, Preparation Download and import the 1951-2006 one percent files with one record per person and per person-year: library(haven) library(httr) tf <- tempfile() ssa_url <- "https://www.ssa.gov/policy/docs/microdata/epuf/epuf2006_sas_files.zip" GET( ssa_url , write_disk( tf ) , progress() ) ssa_files <- unzip( tf , exdir = tempdir() ) ssa_fn <- grep( 'demographic' , ssa_files , value = TRUE ) annual_fn <- grep( 'annual' , ssa_files , value = TRUE ) ssa_tbl <- read_sas( ssa_fn ) annual_tbl <- read_sas( annual_fn ) ssa_df <- data.frame( ssa_tbl ) annual_df <- data.frame( annual_tbl ) names( ssa_df ) <- tolower( names( ssa_df ) ) names( annual_df ) <- tolower( names( annual_df ) ) Sum up 1951-1952 and 1953-2006 earnings, and also 1953-2006 credits, copying the naming convention: summed_earnings_5152 <- with( subset( annual_df , year_earn %in% 1951:1952 ) , aggregate( annual_earnings , list( id ) , sum ) ) names( summed_earnings_5152 ) <- c( 'id' , 'tot_cov_earn5152' ) summed_earnings_5306 <- with( subset( annual_df , year_earn > 1952 ) , aggregate( annual_earnings , list( id ) , sum ) ) names( summed_earnings_5306 ) <- c( 'id' , 'tot_cov_earn5306' ) summed_quarters_5306 <- with( subset( annual_df , year_earn > 1952 ) , aggregate( annual_qtrs , list( id ) , sum ) ) names( summed_quarters_5306 ) <- c( 'id' , 'qc5306' ) Isolate a single year of earnings: earnings_2006 <- annual_df[ annual_df[ , 'year_earn' ] == 2006 , c( 'id' , 'annual_earnings' ) ] names( earnings_2006 ) <- c( 'id' , 'tot_cov_earn06' ) Merge each new column on to the person-level table, then add zeroes to person-years without earnings: stopifnot( all( !is.na( ssa_df ) ) ) before_nrow <- nrow( ssa_df ) ssa_df <- merge( ssa_df , summed_earnings_5152 , all.x = TRUE ) ssa_df <- merge( ssa_df , summed_earnings_5306 , all.x = TRUE ) ssa_df <- merge( ssa_df , summed_quarters_5306 , all.x = TRUE ) ssa_df <- merge( ssa_df , earnings_2006 , all.x = TRUE ) ssa_df[ is.na( ssa_df ) ] <- 0 stopifnot( nrow( ssa_df ) == before_nrow ) Save locally   Save the object at any point: # ssa_fn <- file.path( path.expand( "~" ) , "SSA" , "this_file.rds" ) # saveRDS( ssa_df , file = ssa_fn , compress = FALSE ) Load the same object: # ssa_df <- readRDS( ssa_fn ) Variable Recoding Add new columns to the data set: ssa_df <- transform( ssa_df , decade_of_birth = floor( yob / 10 ) * 10 , sex = factor( sex , levels = 1:2 , labels = c( 'male' , 'female' ) ) , tot_cov_earn3706 = ( tot_cov_earn3750 + tot_cov_earn5152 + tot_cov_earn5306 ) , qc3706 = ( qc3750 + qc5152 + qc5306 ) , any_earnings_2006 = ( tot_cov_earn06 > 0 ) , earnings_periods = factor( ifelse( ( tot_cov_earn5152 + tot_cov_earn5306 > 0 ) & tot_cov_earn3750 > 0 , 1 , ifelse( tot_cov_earn5152 > 0 | tot_cov_earn5306 > 0 , 2 , ifelse( tot_cov_earn3750 > 0 , 3 , 4 ) ) ) , levels = 1:4 , labels = c( 'Earnings in both periods' , 'Earnings during 1951-2006 only' , 'Earnings during 1937-1950 only' , 'No earnings' ) ) ) Analysis Examples with base R   Unweighted Counts Count the unweighted number of records in the table, overall and by groups: nrow( ssa_df ) table( ssa_df[ , "sex" ] , useNA = "always" ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: mean( ssa_df[ , "tot_cov_earn3706" ] ) tapply( ssa_df[ , "tot_cov_earn3706" ] , ssa_df[ , "sex" ] , mean ) Calculate the distribution of a categorical variable, overall and by groups: prop.table( table( ssa_df[ , "decade_of_birth" ] ) ) prop.table( table( ssa_df[ , c( "decade_of_birth" , "sex" ) ] ) , margin = 2 ) Calculate the sum of a linear variable, overall and by groups: sum( ssa_df[ , "tot_cov_earn3706" ] ) tapply( ssa_df[ , "tot_cov_earn3706" ] , ssa_df[ , "sex" ] , sum ) Calculate the median (50th percentile) of a linear variable, overall and by groups: quantile( ssa_df[ , "tot_cov_earn3706" ] , 0.5 ) tapply( ssa_df[ , "tot_cov_earn3706" ] , ssa_df[ , "sex" ] , quantile , 0.5 ) Subsetting Limit your data.frame to individuals with at least forty lifetime credits: sub_ssa_df <- subset( ssa_df , qc3706 >= 40 ) Calculate the mean (average) of this subset: mean( sub_ssa_df[ , "tot_cov_earn3706" ] ) Measures of Uncertainty Calculate the variance, overall and by groups: var( ssa_df[ , "tot_cov_earn3706" ] ) tapply( ssa_df[ , "tot_cov_earn3706" ] , ssa_df[ , "sex" ] , var ) Regression Models and Tests of Association Perform a t-test: t.test( tot_cov_earn3706 ~ any_earnings_2006 , ssa_df ) Perform a chi-squared test of association: this_table <- table( ssa_df[ , c( "any_earnings_2006" , "decade_of_birth" ) ] ) chisq.test( this_table ) Perform a generalized linear model: glm_result <- glm( tot_cov_earn3706 ~ any_earnings_2006 + decade_of_birth , data = ssa_df ) summary( glm_result ) Replication Example This example matches statistics in The 2006 Earnings Public-Use Microdata File: An Introduction: Chart 5. Percentage distribution of individuals in EPUF, by capped Social Security taxable earnings status: chart_five_results <- prop.table( table( ssa_df[ , 'earnings_periods' ] ) ) chart_five_results <- round( 100 * chart_five_results ) stopifnot( chart_five_results[ 'Earnings in both periods' ] == 16 ) stopifnot( chart_five_results[ 'Earnings during 1951-2006 only' ] == 55 ) stopifnot( chart_five_results[ 'Earnings during 1937-1950 only' ] == 4 ) stopifnot( chart_five_results[ 'No earnings' ] == 25 ) Table 4. Average and median Social Security taxable earnings in EPUF, by sex, 1951–2006 (in dollars): nonzero_2006_earners <- ssa_df[ ssa_df[ , 'tot_cov_earn06' ] > 0 , 'tot_cov_earn06' ] stopifnot( round( mean( nonzero_2006_earners ) , 0 ) == 30953 ) stopifnot( round( quantile( nonzero_2006_earners )[ 3 ] , 0 ) == 24000 ) Table A1. Number and percentage distribution of individuals with Social Security taxable earnings records in EPUF, by sex, 1951–2006: nonzero_2006_earners <- ssa_df[ ssa_df[ , 'tot_cov_earn06' ] > 0 , ] stopifnot( round( mean( nonzero_2006_earners[ , 'tot_cov_earn06' ] ) , 0 ) == 30953 ) stopifnot( round( quantile( nonzero_2006_earners[ , 'tot_cov_earn06' ] )[ 3 ] , 0 ) == 24000 ) This example matches statistics in Comparing Earnings Estimates from the 2006 Earnings Public-Use File and the Annual Statistical Supplement: Table 4. Comparing Supplement and EPUF estimates: Number of all, male, and female workers with any earnings during the year, 1951–2006: stopifnot( round( nrow( nonzero_2006_earners ) * 100 , -3 ) == 156280000 ) earners_in_2006_by_sex <- table( nonzero_2006_earners[ , 'sex' ] ) * 100 stopifnot( round( earners_in_2006_by_sex[ 'male' ] , -3 ) == 81576000 ) stopifnot( round( earners_in_2006_by_sex[ 'female' ] , -3 ) == 74681000 ) Analysis Examples with dplyr   The R dplyr library offers an alternative grammar of data manipulation to base R and SQL syntax. dplyr offers many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, and the tidyverse style of non-standard evaluation. This vignette details the available features. As a starting point for SSA users, this code replicates previously-presented examples: library(dplyr) ssa_tbl <- as_tibble( ssa_df ) Calculate the mean (average) of a linear variable, overall and by groups: ssa_tbl %>% summarize( mean = mean( tot_cov_earn3706 ) ) ssa_tbl %>% group_by( sex ) %>% summarize( mean = mean( tot_cov_earn3706 ) ) Analysis Examples with data.table   The R data.table library provides a high-performance version of base R’s data.frame with syntax and feature enhancements for ease of use, convenience and programming speed. data.table offers concise syntax: fast to type, fast to read, fast speed, memory efficiency, a careful API lifecycle management, an active community, and a rich set of features. This vignette details the available features. As a starting point for SSA users, this code replicates previously-presented examples: library(data.table) ssa_dt <- data.table( ssa_df ) Calculate the mean (average) of a linear variable, overall and by groups: ssa_dt[ , mean( tot_cov_earn3706 ) ] ssa_dt[ , mean( tot_cov_earn3706 ) , by = sex ] Analysis Examples with duckdb   The R duckdb library provides an embedded analytical data management system with support for the Structured Query Language (SQL). duckdb offers a simple, feature-rich, fast, and free SQL OLAP management system. This vignette details the available features. As a starting point for SSA users, this code replicates previously-presented examples: library(duckdb) con <- dbConnect( duckdb::duckdb() , dbdir = 'my-db.duckdb' ) dbWriteTable( con , 'ssa' , ssa_df ) Calculate the mean (average) of a linear variable, overall and by groups: dbGetQuery( con , 'SELECT AVG( tot_cov_earn3706 ) FROM ssa' ) dbGetQuery( con , 'SELECT sex , AVG( tot_cov_earn3706 ) FROM ssa GROUP BY sex' ) "],["trends-in-international-mathematics-and-science-study-timss.html", "Trends in International Mathematics and Science Study (TIMSS) Function Definitions Download, Import, Preparation Analysis Examples with the survey library   Replication Example", " Trends in International Mathematics and Science Study (TIMSS) A comparative study of student achievement in math and science across more than 50 nations. Grade-specific tables with one record per school, student, teacher, plus files containing student achievement, home background, student-teacher linkage, and within-country scoring reliability. A complex survey generalizing to fourth- and eighth-grade populations of participating countries. Released quadrennially since 1995. Funded by the International Association for the Evaluation of Educational Achievement, run at BC. Please skim before you begin: TIMSS 2019 User Guide for the International Database, 2nd Edition Methods and Procedures: TIMSS 2019 Technical Report This human-composed haiku or a bouquet of artificial intelligence-generated limericks # brando for stella, # gump's jenny, rock's adrian, # students toward math test Function Definitions This survey uses a multiply-imputed variance estimation technique described in Methods Chapter 14. Most users do not need to study this function carefully. Define a function specific to only this dataset: timss_MIcombine <- function (results, variances, call = sys.call(), df.complete = Inf, ...) { m <- length(results) oldcall <- attr(results, "call") if (missing(variances)) { variances <- suppressWarnings(lapply(results, vcov)) results <- lapply(results, coef) } vbar <- variances[[1]] cbar <- results[[1]] for (i in 2:m) { cbar <- cbar + results[[i]] vbar <- vbar + variances[[i]] } cbar <- cbar/m vbar <- vbar/m # MODIFICATION # evar <- var(do.call("rbind", results)) evar <- sum( ( unlist( results ) - cbar )^2 / 4 ) r <- (1 + 1/m) * evar/vbar df <- (m - 1) * (1 + 1/r)^2 if (is.matrix(df)) df <- diag(df) if (is.finite(df.complete)) { dfobs <- ((df.complete + 1)/(df.complete + 3)) * df.complete * vbar/(vbar + evar) if (is.matrix(dfobs)) dfobs <- diag(dfobs) df <- 1/(1/dfobs + 1/df) } if (is.matrix(r)) r <- diag(r) rval <- list(coefficients = cbar, variance = vbar + evar * (m + 1)/m, call = c(oldcall, call), nimp = m, df = df, missinfo = (r + 2/(df + 3))/(r + 1)) class(rval) <- "MIresult" rval } Download, Import, Preparation Download and unzip the 2019 fourth grade international database: library(httr) tf <- tempfile() this_url <- "https://timss2019.org/international-database/downloads/T19_G4_SPSS%20Data.zip" GET( this_url , write_disk( tf ) , progress() ) unzipped_files <- unzip( tf , exdir = tempdir() ) Import and stack each of the student context data files for Albania through Canada: library(haven) # limit unzipped files to those starting with `asg` followed by three letters followed by `m7` asg_fns <- unzipped_files[ grepl( '^asg[a-z][a-z][a-z]m7' , basename( unzipped_files ) ) ] # further limit asg files to the first ten countries countries_thru_canada <- c("alb", "arm", "aus", "aut", "aze", "bhr", "bfl", "bih", "bgr", "can") fns_thru_canada <- paste0( paste0( '^asg' , countries_thru_canada , 'm7' ) , collapse = "|" ) asg_alb_can_fns <- asg_fns[ grepl( fns_thru_canada , basename( asg_fns ) ) ] timss_df <- NULL for( spss_fn in asg_alb_can_fns ){ this_tbl <- read_spss( spss_fn ) this_tbl <- zap_labels( this_tbl ) this_df <- data.frame( this_tbl ) names( this_df ) <- tolower( names( this_df ) ) timss_df <- rbind( timss_df , this_df ) } # order the data.frame by unique student id timss_df <- timss_df[ with( timss_df , order( idcntry , idstud ) ) , ] Save locally   Save the object at any point: # timss_fn <- file.path( path.expand( "~" ) , "TIMSS" , "this_file.rds" ) # saveRDS( timss_df , file = timss_fn , compress = FALSE ) Load the same object: # timss_df <- readRDS( timss_fn ) Survey Design Definition Construct a multiply-imputed, complex sample survey design: From among possibly plausible values, determine all columns that are multiply-imputed plausible values: # identify all columns ending with `01` thru `05` ppv <- grep( "(.*)0[1-5]$" , names( timss_df ) , value = TRUE ) # remove those ending digits ppv_prefix <- gsub( "0[1-5]$" , "" , ppv ) # identify each of the possibilities with exactly five matches (five implicates) pv <- names( table( ppv_prefix )[ table( ppv_prefix ) == 5 ] ) # identify each of the `01` thru `05` plausible value columns pv_columns <- grep( paste0( "^" , pv , "0[1-5]$" , collapse = "|" ) , names( timss_df ) , value = TRUE ) Extract those multiply-imputed columns into a separate data.frame, then remove them from the source: pv_wide_df <- timss_df[ c( 'idcntry' , 'idstud' , pv_columns ) ] timss_df[ pv_columns ] <- NULL Reshape these columns from one record per student to one record per student per implicate: pv_long_df <- reshape( pv_wide_df , varying = lapply( paste0( pv , '0' ) , paste0 , 1:5 ) , direction = 'long' , timevar = 'implicate' , idvar = c( 'idcntry' , 'idstud' ) ) names( pv_long_df ) <- gsub( "01$" , "" , names( pv_long_df ) ) Merge the columns from the source data.frame onto the one record per student per implicate data.frame: timss_long_df <- merge( timss_df , pv_long_df ) timss_long_df <- timss_long_df[ with( timss_long_df , order( idcntry , idstud ) ) , ] stopifnot( nrow( timss_long_df ) == nrow( pv_long_df ) ) stopifnot( nrow( timss_long_df ) / 5 == nrow( timss_df ) ) Divide the five plausible value implicates into a list with five data.frames based on the implicate number: timss_list <- split( timss_long_df , timss_long_df[ , 'implicate' ] ) Construct a replicate weights table following the estimation technique described in Methods Chapter 14: weights_df <- timss_df[ c( 'jkrep' , 'jkzone' ) ] for( j in 1:75 ){ for( i in 0:1 ){ weights_df[ weights_df[ , 'jkzone' ] != j , paste0( 'rw' , i , j ) ] <- 1 weights_df[ weights_df[ , 'jkzone' ] == j , paste0( 'rw' , i , j ) ] <- 2 * ( weights_df[ weights_df[ , 'jkzone' ] == j , 'jkrep' ] == i ) } } weights_df[ c( 'jkrep' , 'jkzone' ) ] <- NULL Define the design: library(survey) library(mitools) timss_design <- svrepdesign( weights = ~totwgt , repweights = weights_df , data = imputationList( timss_list ) , type = "other" , scale = 0.5 , rscales = rep( 1 , 150 ) , combined.weights = FALSE , mse = TRUE ) Variable Recoding Add new columns to the data set: timss_design <- update( timss_design , one = 1 , countries_thru_canada = factor( as.numeric( idcntry ) , levels = c(8L, 51L, 36L, 40L, 31L, 48L, 956L, 70L, 100L, 124L) , labels = c("Albania", "Armenia", "Australia", "Austria", "Azerbaijan", "Bahrain", "Belgium (Flemish)", "Bosnia and Herzegovina", "Bulgaria", "Canada") ) , sex = factor( asbg01 , levels = 1:2 , labels = c( "female" , "male" ) ) , born_in_country = ifelse( asbg07 %in% 1:2 , as.numeric( asbg07 == 1 ) , NA ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: timss_MIcombine( with( timss_design , svyby( ~ one , ~ one , unwtd.count ) ) ) timss_MIcombine( with( timss_design , svyby( ~ one , ~ sex , unwtd.count ) ) ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: timss_MIcombine( with( timss_design , svytotal( ~ one ) ) ) timss_MIcombine( with( timss_design , svyby( ~ one , ~ sex , svytotal ) ) ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: timss_MIcombine( with( timss_design , svymean( ~ asmmat , na.rm = TRUE ) ) ) timss_MIcombine( with( timss_design , svyby( ~ asmmat , ~ sex , svymean , na.rm = TRUE ) ) ) Calculate the distribution of a categorical variable, overall and by groups: timss_MIcombine( with( timss_design , svymean( ~ countries_thru_canada ) ) ) timss_MIcombine( with( timss_design , svyby( ~ countries_thru_canada , ~ sex , svymean ) ) ) Calculate the sum of a linear variable, overall and by groups: timss_MIcombine( with( timss_design , svytotal( ~ asmmat , na.rm = TRUE ) ) ) timss_MIcombine( with( timss_design , svyby( ~ asmmat , ~ sex , svytotal , na.rm = TRUE ) ) ) Calculate the weighted sum of a categorical variable, overall and by groups: timss_MIcombine( with( timss_design , svytotal( ~ countries_thru_canada ) ) ) timss_MIcombine( with( timss_design , svyby( ~ countries_thru_canada , ~ sex , svytotal ) ) ) Calculate the median (50th percentile) of a linear variable, overall and by groups: timss_MIcombine( with( timss_design , svyquantile( ~ asmmat , 0.5 , se = TRUE , na.rm = TRUE ) ) ) timss_MIcombine( with( timss_design , svyby( ~ asmmat , ~ sex , svyquantile , 0.5 , se = TRUE , ci = TRUE , na.rm = TRUE ) ) ) Estimate a ratio: timss_MIcombine( with( timss_design , svyratio( numerator = ~ asssci , denominator = ~ asmmat ) ) ) Subsetting Restrict the survey design to Australia, Austria, Azerbaijan, Belgium (French): sub_timss_design <- subset( timss_design , idcntry %in% c( 36 , 40 , 31 , 956 ) ) Calculate the mean (average) of this subset: timss_MIcombine( with( sub_timss_design , svymean( ~ asmmat , na.rm = TRUE ) ) ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- timss_MIcombine( with( timss_design , svymean( ~ asmmat , na.rm = TRUE ) ) ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- timss_MIcombine( with( timss_design , svyby( ~ asmmat , ~ sex , svymean , na.rm = TRUE ) ) ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( timss_design$designs[[1]] ) Calculate the complex sample survey-adjusted variance of any statistic: timss_MIcombine( with( timss_design , svyvar( ~ asmmat , na.rm = TRUE ) ) ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement timss_MIcombine( with( timss_design , svymean( ~ asmmat , na.rm = TRUE , deff = TRUE ) ) ) # SRS with replacement timss_MIcombine( with( timss_design , svymean( ~ asmmat , na.rm = TRUE , deff = "replace" ) ) ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: # MIsvyciprop( ~ born_in_country , timss_design , # method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: # MIsvyttest( asmmat ~ born_in_country , timss_design ) Perform a chi-squared test of association for survey data: # MIsvychisq( ~ born_in_country + countries_thru_canada , timss_design ) Perform a survey-weighted generalized linear model: glm_result <- timss_MIcombine( with( timss_design , svyglm( asmmat ~ born_in_country + countries_thru_canada ) ) ) summary( glm_result ) Replication Example This example matches the mean proficiency and standard error of the Australia row of the Summary Statistics and Standard Errors for Proficiency in Overall Mathematics-Grade 4 table from the Appendix 14A: Summary Statistics and Standard Errors for Proficiency in Grade 4 Mathematics: australia_design <- subset( timss_design , countries_thru_canada %in% "Australia" ) stopifnot( nrow( australia_design ) == 5890 ) result <- timss_MIcombine( with( australia_design , svymean( ~ asmmat ) ) ) stopifnot( round( coef( result ) , 3 ) == 515.880 ) stopifnot( round( SE( result ) , 3 ) == 2.776 ) This example matches the jackknife sampling, imputation, and total variances of the same row: australia_fn <- unzipped_files[ grepl( 'asgaus' , basename( unzipped_files ) ) ] australia_tbl <- read_spss( australia_fn ) australia_tbl <- zap_labels( australia_tbl ) australia_df <- data.frame( australia_tbl ) names( australia_df ) <- tolower( names( australia_df ) ) estimate <- mean( c( with( australia_df , weighted.mean( asmmat01 , totwgt ) ) , with( australia_df , weighted.mean( asmmat02 , totwgt ) ) , with( australia_df , weighted.mean( asmmat03 , totwgt ) ) , with( australia_df , weighted.mean( asmmat04 , totwgt ) ) , with( australia_df , weighted.mean( asmmat05 , totwgt ) ) ) ) stopifnot( round( estimate , 3 ) == 515.880 ) for( k in 1:5 ){ this_variance <- 0 for( j in 1:75 ){ for( i in 0:1 ){ this_variance <- this_variance + ( weighted.mean( australia_df[ , paste0( 'asmmat0' , k ) ] , ifelse( j == australia_df[ , 'jkzone' ] , australia_df[ , 'totwgt' ] * 2 * ( australia_df[ , 'jkrep' ] == i ) , australia_df[ , 'totwgt' ] ) ) - weighted.mean( australia_df[ , paste0( 'asmmat0' , k ) ] , australia_df[ , 'totwgt' ] ) )^2 } } assign( paste0( 'v' , k ) , this_variance * 0.5 ) } sampling_variance <- mean( c( v1 , v2 , v3 , v4 , v5 ) ) stopifnot( round( sampling_variance , 3 ) == 7.397 ) imputation_variance <- ( 6 / 5 ) * ( ( ( with( australia_df , weighted.mean( asmmat01 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asmmat02 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asmmat03 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asmmat04 , totwgt ) ) - estimate )^2 / 4 ) + ( ( with( australia_df , weighted.mean( asmmat05 , totwgt ) ) - estimate )^2 / 4 ) ) stopifnot( round( imputation_variance , 3 ) == 0.309 ) stopifnot( round( sampling_variance + imputation_variance , 3 ) == 7.706 ) "],["youth-risk-behavior-surveillance-system-yrbss.html", "Youth Risk Behavior Surveillance System (YRBSS) Download, Import, Preparation Analysis Examples with the survey library   Replication Example Analysis Examples with srvyr  ", " Youth Risk Behavior Surveillance System (YRBSS) The high school edition of the Behavioral Risk Factor Surveillance System (BRFSS). One table with one row per sampled youth respondent. A complex sample survey designed to generalize to all public and private school students in grades 9-12 in the United States. Released biennially since 1993. Administered by the Centers for Disease Control and Prevention. Please skim before you begin: Methodology of the Youth Risk Behavior Surveillance System Wikipedia Entry This human-composed haiku or a bouquet of artificial intelligence-generated limericks # maladolescence # epidemiology # sex, drugs, rock and roll Download, Import, Preparation Load the SAScii library to interpret a SAS input program, and also re-arrange the SAS input program: library(SAScii) sas_url <- "https://www.cdc.gov/healthyyouth/data/yrbs/files/2019/2019XXH-SAS-Input-Program.sas" sas_text <- tolower( readLines( sas_url ) ) # find the (out of numerical order) # `site` location variable's position # within the SAS input program site_location <- which( sas_text == '@1 site $3.' ) # find the start field's position # within the SAS input program input_location <- which( sas_text == "input" ) # create a vector from 1 to the length of the text file sas_length <- seq( length( sas_text ) ) # remove the site_location sas_length <- sas_length[ -site_location ] # re-insert the site variable's location # immediately after the starting position sas_reorder <- c( sas_length[ seq( input_location ) ] , site_location , sas_length[ seq( input_location + 1 , length( sas_length ) ) ] ) # re-order the sas text file sas_text <- sas_text[ sas_reorder ] sas_tf <- tempfile() writeLines( sas_text , sas_tf ) Download and import the national file: dat_tf <- tempfile() dat_url <- "https://www.cdc.gov/healthyyouth/data/yrbs/files/2019/XXH2019_YRBS_Data.dat" download.file( dat_url , dat_tf , mode = 'wb' ) yrbss_df <- read.SAScii( dat_tf , sas_tf ) names( yrbss_df ) <- tolower( names( yrbss_df ) ) yrbss_df[ , 'one' ] <- 1 Save locally   Save the object at any point: # yrbss_fn <- file.path( path.expand( "~" ) , "YRBSS" , "this_file.rds" ) # saveRDS( yrbss_df , file = yrbss_fn , compress = FALSE ) Load the same object: # yrbss_df <- readRDS( yrbss_fn ) Survey Design Definition Construct a complex sample survey design: library(survey) yrbss_design <- svydesign( ~ psu , strata = ~ stratum , data = yrbss_df , weights = ~ weight , nest = TRUE ) Variable Recoding Add new columns to the data set: yrbss_design <- update( yrbss_design , q2 = q2 , never_rarely_wore_seat_belt = as.numeric( qn8 == 1 ) , ever_used_marijuana = as.numeric( qn45 == 1 ) , tried_to_quit_tobacco_past_year = as.numeric( q39 == 2 ) , used_tobacco_past_year = as.numeric( q39 > 1 ) ) Analysis Examples with the survey library   Unweighted Counts Count the unweighted number of records in the survey sample, overall and by groups: sum( weights( yrbss_design , "sampling" ) != 0 ) svyby( ~ one , ~ ever_used_marijuana , yrbss_design , unwtd.count ) Weighted Counts Count the weighted size of the generalizable population, overall and by groups: svytotal( ~ one , yrbss_design ) svyby( ~ one , ~ ever_used_marijuana , yrbss_design , svytotal ) Descriptive Statistics Calculate the mean (average) of a linear variable, overall and by groups: svymean( ~ bmipct , yrbss_design , na.rm = TRUE ) svyby( ~ bmipct , ~ ever_used_marijuana , yrbss_design , svymean , na.rm = TRUE ) Calculate the distribution of a categorical variable, overall and by groups: svymean( ~ q2 , yrbss_design , na.rm = TRUE ) svyby( ~ q2 , ~ ever_used_marijuana , yrbss_design , svymean , na.rm = TRUE ) Calculate the sum of a linear variable, overall and by groups: svytotal( ~ bmipct , yrbss_design , na.rm = TRUE ) svyby( ~ bmipct , ~ ever_used_marijuana , yrbss_design , svytotal , na.rm = TRUE ) Calculate the weighted sum of a categorical variable, overall and by groups: svytotal( ~ q2 , yrbss_design , na.rm = TRUE ) svyby( ~ q2 , ~ ever_used_marijuana , yrbss_design , svytotal , na.rm = TRUE ) Calculate the median (50th percentile) of a linear variable, overall and by groups: svyquantile( ~ bmipct , yrbss_design , 0.5 , na.rm = TRUE ) svyby( ~ bmipct , ~ ever_used_marijuana , yrbss_design , svyquantile , 0.5 , ci = TRUE , na.rm = TRUE ) Estimate a ratio: svyratio( numerator = ~ tried_to_quit_tobacco_past_year , denominator = ~ used_tobacco_past_year , yrbss_design , na.rm = TRUE ) Subsetting Restrict the survey design to youths who ever drank alcohol: sub_yrbss_design <- subset( yrbss_design , qn40 > 1 ) Calculate the mean (average) of this subset: svymean( ~ bmipct , sub_yrbss_design , na.rm = TRUE ) Measures of Uncertainty Extract the coefficient, standard error, confidence interval, and coefficient of variation from any descriptive statistics function result, overall and by groups: this_result <- svymean( ~ bmipct , yrbss_design , na.rm = TRUE ) coef( this_result ) SE( this_result ) confint( this_result ) cv( this_result ) grouped_result <- svyby( ~ bmipct , ~ ever_used_marijuana , yrbss_design , svymean , na.rm = TRUE ) coef( grouped_result ) SE( grouped_result ) confint( grouped_result ) cv( grouped_result ) Calculate the degrees of freedom of any survey design object: degf( yrbss_design ) Calculate the complex sample survey-adjusted variance of any statistic: svyvar( ~ bmipct , yrbss_design , na.rm = TRUE ) Include the complex sample design effect in the result for a specific statistic: # SRS without replacement svymean( ~ bmipct , yrbss_design , na.rm = TRUE , deff = TRUE ) # SRS with replacement svymean( ~ bmipct , yrbss_design , na.rm = TRUE , deff = "replace" ) Compute confidence intervals for proportions using methods that may be more accurate near 0 and 1. See ?svyciprop for alternatives: svyciprop( ~ never_rarely_wore_seat_belt , yrbss_design , method = "likelihood" , na.rm = TRUE ) Regression Models and Tests of Association Perform a design-based t-test: svyttest( bmipct ~ never_rarely_wore_seat_belt , yrbss_design ) Perform a chi-squared test of association for survey data: svychisq( ~ never_rarely_wore_seat_belt + q2 , yrbss_design ) Perform a survey-weighted generalized linear model: glm_result <- svyglm( bmipct ~ never_rarely_wore_seat_belt + q2 , yrbss_design ) summary( glm_result ) Replication Example This example matches statistics, standard errors, and confidence intervals from the “never/rarely wore seat belt” row of PDF page 29 of this CDC analysis software document: unwtd_count_result <- unwtd.count( ~ never_rarely_wore_seat_belt , yrbss_design ) stopifnot( coef( unwtd_count_result ) == 11149 ) wtd_n_result <- svytotal( ~ one , subset( yrbss_design , !is.na( never_rarely_wore_seat_belt ) ) ) stopifnot( round( coef( wtd_n_result ) , 0 ) == 12132 ) share_result <- svymean( ~ never_rarely_wore_seat_belt , yrbss_design , na.rm = TRUE ) stopifnot( round( coef( share_result ) , 4 ) == .0654 ) stopifnot( round( SE( share_result ) , 4 ) == .0065 ) ci_result <- svyciprop( ~ never_rarely_wore_seat_belt , yrbss_design , na.rm = TRUE , method = "beta" ) stopifnot( round( confint( ci_result )[1] , 4 ) == 0.0529 ) stopifnot( round( confint( ci_result )[2] , 2 ) == 0.08 ) Analysis Examples with srvyr   The R srvyr library calculates summary statistics from survey data, such as the mean, total or quantile using dplyr-like syntax. srvyr allows for the use of many verbs, such as summarize, group_by, and mutate, the convenience of pipe-able functions, the tidyverse style of non-standard evaluation and more consistent return types than the survey package. This vignette details the available features. As a starting point for YRBSS users, this code replicates previously-presented examples: library(srvyr) yrbss_srvyr_design <- as_survey( yrbss_design ) Calculate the mean (average) of a linear variable, overall and by groups: yrbss_srvyr_design %>% summarize( mean = survey_mean( bmipct , na.rm = TRUE ) ) yrbss_srvyr_design %>% group_by( ever_used_marijuana ) %>% summarize( mean = survey_mean( bmipct , na.rm = TRUE ) ) "],["404.html", "Page not found", " Page not found The page you requested cannot be found (perhaps it was moved or renamed). You may want to try searching to find the page's new location, or use the table of contents to find the page you are looking for. "]] diff --git a/metadata/brfss.txt b/metadata/brfss.txt index 80145e2c7..b646c8bc1 100644 --- a/metadata/brfss.txt +++ b/metadata/brfss.txt @@ -43,7 +43,7 @@ library(haven) zip_tf <- tempfile() -zip_url <- "https://www.cdc.gov/brfss/annual_data/2021/files/LLCP2021XPT.zip" +zip_url <- "https://www.cdc.gov/brfss/annual_data/2022/files/LLCP2022XPT.zip" download.file( zip_url , zip_tf , mode = 'wb' ) @@ -173,7 +173,7 @@ needs_srvyr_block: yes ~~~{replication_example_block} ## Replication Example {-} -This example matches Alaska's confidence intervals from the [BRFSS Prevalence & Trends Data](https://nccd.cdc.gov/BRFSSPrevalence/rdPage.aspx?rdReport=DPH_BRFSS.ExploreByTopic&irbLocationType=StatesAndMMSA&islClass=CLASS07&islTopic=TOPIC28&islYear=2021&rdRnd=24558): +This example matches Alaska's confidence intervals from the [BRFSS Prevalence & Trends Data](https://nccd.cdc.gov/BRFSSPrevalence/rdPage.aspx?rdReport=DPH_BRFSS.ExploreByTopic&irbLocationType=StatesAndMMSA&islClass=CLASS07&islTopic=TOPIC28&islYear=2022&rdRnd=24558): ```{r eval = FALSE , results = "hide" } @@ -189,10 +189,10 @@ result <- na.rm = TRUE ) -stopifnot( round( confint( result )[ 1 , 1 ] , 3 ) == 0.094 ) -stopifnot( round( confint( result )[ 1 , 2 ] , 3 ) == 0.122 ) -stopifnot( round( confint( result )[ 2 , 1 ] , 3 ) == 0.878 ) -stopifnot( round( confint( result )[ 2 , 2 ] , 3 ) == 0.906 ) +stopifnot( round( confint( result )[ 1 , 1 ] , 3 ) == 0.092 ) +stopifnot( round( confint( result )[ 1 , 2 ] , 3 ) == 0.114 ) +stopifnot( round( confint( result )[ 2 , 1 ] , 3 ) == 0.886 ) +stopifnot( round( confint( result )[ 2 , 2 ] , 3 ) == 0.908 ) ``` diff --git a/vignetterator/generate.R b/vignetterator/generate.R index f5a69d099..81622a144 100644 --- a/vignetterator/generate.R +++ b/vignetterator/generate.R @@ -1,4 +1,4 @@ -commit_memo <- "'fixes https://github.com/ajdamico/asdfree/issues/403'" +commit_memo <- "'brfss 2022'" # source( file.path( path.expand( "~" ) , "Github/asdfree/vignetterator/generate.R" ) )