これは統計分析システムRの活用方法を解説する記事のために、リアルな子供の人口動態を解析したら面白いかなと思って作りました。Rにはirisデータセットという便利な基礎データが付いてるんですが、それを使った解説記事は沢山あるので、面白みが無いんですよね～！
日本政府統計ポータルサイトより2023年の5～17歳の身長と体重を抽出
このスクリプトは、以下の２つのサイトで入手できるExcelファイルを元に作成しました。
政府統計コード 00400002
調査の概要：
学校保健統計調査は、学校における幼児、児童及び生徒の発育、健康等の状態を明らかにすることを目的としています。本調査は、幼稚園、幼保連携型認定こども園、小学校、中学校、義務教育学校、高等学校及び中等教育学校の幼児、児童及び生徒を対象に、毎年実施されます。学校保健安全法により義務づけられている健康診断の結果に基づいて、発育及び健康状態に関する事項（身長、体重及び被患率等）に関する調査を行っており、その結果は、学校保健安全法及び学校給食法の改正をはじめとした学校保健行政の施策の立案検討の際の基礎資料としてだけでなく、我が国の学校保健に関する基礎資料として、各方面で活用されています。
提供統計名：学校保健統計調査
提供分類1：令和５年度
統計表名：身長と体重の相関表及び身長別体重の平均値政府統計コード：00200524
調査の概要：
人口推計は、国勢調査による人口を基に、その後の各月における出生・死亡、入国・出国などの人口の動きを他の人口関連資料から得ることで、毎月1日現在の男女別、年齢階級別の人口を推計しています。また、毎年10月1日現在の全国各歳別結果及び都道府県別結果も推計しています。
推計結果は、各種白書や国際機関における人口分析、経済分析等の基礎資料として利用されています。
提供統計名：人口推計
提供分類1：各年10月1日現在人口
表分類： 全国
統計表名：年齢（各歳）、男女別人口及び人口性比－総人口、日本人人口（2023年10月1日現在） 人口推計は、国勢調査による悉皆（しっかい）調査のデータを元に得られた推計値で、殆どの人口関連資料の元になっています。
学校保健統計調査は、５歳～１７歳の、学校等に通学している方のデータで、５歳の男児1000人に対する割合になっているわけです。Excelシートが、性別、年齢別に、横軸が体重、縦軸が身長の、‰（パーミル）値になっています。
つまり、各年齢、性別毎の人口値で補正しないといけないわけですね。また、通学していない方のデータは含まれません。（身長・体重のデータを集めようがない）
統計用データ作成Perlスクリプト
ということで、作成したperlスクリプトです。各年齢・性別毎の人口については、内部変数に埋め込みました。（手抜き）
学校保健調査のExcelシートは膨大なので、PerlからExcelをOLEで起動して、各シートのデータをテキストデータとして抽出してから、分析可能な生データを作成しています。
例えば、５歳の男児で、身長100cm、体重15kgの子は2.6‰なので、5歳の男児の人口468(千人)×2.6/1000=1.22≒１人（四捨五入）って感じで人数を割り出し、その人数分だけレコードを作るわけです。このように作業することで、統計分析可能なメタデータが作成できます。
（ただ、あまりにも階級が細かすぎて度数が0.1と小さく、データの欠落が目立ったので、今回は50で割りました。度数0.1=1人になる計算です。これ以上データ量を増やしたら、Excelがデータを読み込めませんでした。結局、26万人のデータになりました。）
もし、平均値と標準偏差しか示されていない場合は、乱数等で正規分布シミュレートをしないといけませんが、このデータはかなり細かい階級値になっていたので、単純に同じ身長・体重のレコード数を人数分作るだけで済みました。（それでもかなり大変なんですよ。）
完成したスクリプトは、あっという間にデータを作ってくれます。一応、各シートのデータの取りこぼしが無いかを確認するためのタブ区切りテキストも作成するようになってます。
一応、Excelファイル名「r5_hoken_sanko_01.xlsx」がある所と同じフォルダでスクリプトを実行すると、統計解析ソフトRで扱える「e-stat_hw_2023.csv」ファイルが、数秒で出力されます。2023年度以外のデータを処理したい場合は、スクリプト内のTAB区切りテキストで埋め込んである、人口推計データを差し替えないといけません。
Excelファイルから取り込むように改造出来る方は、是非、チャレンジしてみてね。
#!/usr/bin/perl
# 2003年の学校保健調査より、メタ分析用のデータを作成する。
#必ずソースをUTF-8で記載すること。
use strict;
use Encode;
#use Encode::JP::H2Z;
use utf8;
use Win32::OLE qw(in with);
use Win32::OLE::Const 'Microsoft Excel';
use Win32::OLE::Enum;
binmode STDIN, ":encoding(cp932)"; # 入力なのに、何故かencoding
binmode STDOUT, ":encoding(cp932)";
binmode STDERR, ":encoding(cp932)";
# ファイルハンドル<IN>等からの入力時はdecodeが必要
# ファイルハンドル<OUT>等への出力時はencodeが必要
our $debug=1;
#=================
# 2023年の年齢性別人口（埋め込み。 手抜きです。）
#Age M F
my $population=
'0 388 369
1 409 388
2 423 404
3 427 408
4 446 425
5 468 447
6 480 459
7 502 477
8 514 490
9 514 488
10 525 501
11 527 503
12 541 514
13 546 519
14 548 521
15 559 532
16 556 528
17 551 524
18 559 530
19 593 562
20 606 569
21 632 595
22 653 616
23 663 622
24 657 622
25 668 631
26 665 629
27 664 626
28 670 632
29 666 627
30 650 612
31 653 617
32 647 614
33 657 626
34 667 637
35 687 655
36 702 673
37 712 682
38 734 710
39 758 734
40 767 744
41 766 746
42 773 751
43 806 784
44 826 802
45 856 833
46 878 854
47 920 894
48 956 931
49 1010 983
50 1023 1003
51 1006 983
52 974 956
53 942 927
54 924 914
55 900 891
56 895 889
57 695 697
58 855 856
59 799 802
60 776 782
61 748 757
62 729 742
63 728 748
64 738 760
65 711 740
66 687 718
67 715 754
68 732 776
69 723 776
70 756 824
71 788 868
72 822 915
73 864 981
74 931 1068
75 900 1052
76 836 990
77 502 615
78 518 657
79 610 795
80 570 757
81 562 765
82 520 727
83 445 645
84 361 543
85 355 561
86 334 552
87 301 526
88 252 474
89 206 418
90 176 386
91 144 340
92 113 293
93 85 242
94 65 203
95 48 166
96 31 117
97 21 89
98 13 63
99 8 43
100 11 77';
#=================
our %Population=(); # 人口DBを連想配列で作成。性別と年齢をキーに人口を返す
for my $d (split(/\n/,$population)) {
my ($Age,$M,$F)=split(/\t/,$d);
$Population{'M'.$Age}=$M;
$Population{'F'.$Age}=$F;
}
our $ExcelDir=$0; #実行中のplスクリプトフルパス
$ExcelDir=&de_sjis($ExcelDir);
$ExcelDir=~s/[^\\]+\.pl$//;
&vv('$ExcelDir',$ExcelDir);
# Excel オブジェクトはグローバル変数として宣言し取得。（そうしないと何個もExcelが開くので）
our $Excel=Win32::OLE->GetActiveObject('Excel.Application') || Win32::OLE->new('Excel.Application','Quit');
#Excel ファイルは絶対pathでないと開かないようです。
#取り合えず2023年のデータだけ。（余りにも膨大になるので）
open(OUT,'>e-stat_hw_2023.csv');
print OUT 'Year,Sex,Age,Height,Weight',"\n";
#2023年の、各年齢性別毎の身長と体重の度数（‰）なので、人口による補正が必要。
&excel2text($ExcelDir,"r5_hoken_sanko_01.xlsx");
$Excel->Quit();
close(OUT);
print '[Finish!]',"\n";
<>;
exit;
sub excel2text
{
my ($ExcelDir,$ExFileName)=@_;
print 'ExFileName=[',$ExcelDir.$ExFileName,']',"\n";
my $FNameHead=$ExFileName;
$FNameHead=~s/\.(xls|xlsx)$//;
&vv('$FNameHead',$FNameHead);
my $Book=$Excel->Workbooks->Open(&en_sjis($ExcelDir.$ExFileName));
print 'BookName=[',&de_sjis($Book->Name),']',"\n";
my $SheetCnt=$Book->WorkSheets->Count;
print 'SheetCnt=[',$SheetCnt,']',"\n";
for (my $i=1;$i<=$SheetCnt;$i++) { # 全シート対象
my $Sheet_TSV=''; # Tab区切りテキストのイメージを格納する変数
my $Sheet=$Book->Worksheets($i);
my $SheetName=$Sheet->{'Name'};
$SheetName=&de_sjis($SheetName);
print 'SheetName=[',$SheetName,']',"\n";
my $MaxRow = $Sheet->Cells->SpecialCells(xlCellTypeLastCell)->{'Row'};
my $MaxCol = $Sheet->Cells->SpecialCells(xlCellTypeLastCell)->{'Column'};
print 'MaxRow=[',$MaxRow,']',"\n";
print 'MaxCol=[',$MaxCol,']',"\n";
for (my $row=1; $row<=$MaxRow+1; $row++) {
for (my $col=1; $col<=$MaxCol+1; $col++) {
my $str1=$Sheet->Cells($row,$col)->{'Value'};
$str1=&de_sjis($str1); # CP932からperl内部コードへデコード
$str1=~s/(\t|\r|\n)//g; # Tabや改行文字を削除する
$Sheet_TSV.=$str1."\t"; # Tab区切りテキストとして保存
}
chop($Sheet_TSV); # 最後に足したTABを捨てる
$Sheet_TSV.="\n"; # 最後に改行コードを追加。
}
&out_meta_data($Sheet_TSV,'2023');
}
$Excel->{DisplayAlerts} = 'False';
$Excel->Workbooks->close();
close(OUT2);
}
print '[Finish!]',"\n";
<>;
exit;
#---------------------------
# $Sheet_TSV のイメージ
#1 身長と体重の相関表及び身長別体重の平均値（26－1）
#男－5歳 （‰） （‰） （‰） （‰） ・・・ （‰） （‰） （kg） （kg）
# 体重 体重 体重 体重 ・・・ 体重 体重 体重 体重
# 計 ～11kg 12kg 13kg ・・・ 36kg 37kg～ 平均値 標準偏差
#身長 計 1000.0 0.0 0.2 2.2 ・・・ 0.3 0.5 19.2 2.75
#身長 ～93cm 0.5 0.0 - 0.2 ・・・ - - 14.2 1.45
#身長 94cm 0.2 - 0.0 0.1 ・・・ - - 13.6 1.44
#身長 95cm 0.3 - - 0.1 ・・・ - - 13.7 0.53
#・・・
#身長 129cm 0.2
#身長 130cm～ 0.3
sub out_meta_data
{
my($ds,$Year)=@_;
# $ds には上記TSVイメージが入っている。
my @ds=split(/\n/,$ds);
#性別と年齢
&vv('$ds[1]',$ds[1]);
my ($sex_age)=split(/\t/,$ds[1]);
my ($Sex,$Age)=();
$sex_age=~s/(男|女)\D+(\d+)歳//;
$Sex=$1;
$Age=$2;
if ($Sex eq '男') {
$Sex='M';
} else {
$Sex='F';
}
&vv('$Sex',$Sex);
&vv('$Age',$Age);
open(OUT2,'>'.$Year.$Sex.$Age.'.txt'); # デバッグ用にテキストに吐く
# 体重を拾う
&vv('$ds[3]',$ds[3]);
my ($title,$height_org,@weight_org)=split(/\t/,$ds[3]);# index 3 行目に体重データあり 最初の２カラムを捨てる
my @weight = map { $_ =~ s/\D*//g; $_ } @weight_org; # 数値以外を削除
&vv('@weight',join(' ',@weight));
# <>;
my $i=5; # データは５行目からスタート
my $continue_flug=1;
while($continue_flug) {
# 身長の値を拾う
my ($title,$height_org,@dosuu_org)=split(/\t/,$ds[$i]); # 最初の２カラムを捨てる(@weightにindexを合わせる)
my @dosuu= map { $_ =~ s/-/0/; $_ } @dosuu_org; # マイナスを0に置換
my $Height=$height_org;
$Height=~s/\D*//g; # 数値以外を削除
&vv('$Height',$Height);
$Height+=0; # 強制的に数値にする。NULLが0になる。
if ($Height == 0 ) {
$continue_flug=0;
last;
}
for (my $i2=3;$i2<=$#weight;$i2++) {
&vv('$weight[$i2]',$weight[$i2]);
my $Weight=$weight[$i2];
my $Dosuu1000=0;
if ($Weight>0) { # 「平均値」「標準偏差」等の体重データが無い所のデータを捨てる
$Dosuu1000=int($Population{$Sex.$Age}*$dosuu[$i2]/50+0.5); #各性別年齢の人口に度数を掛け四捨五入(0.1=1人になるよう50で割った)
if ($Dosuu1000 > 0) { # 度数が整数で存在する場合のみ
&vv('$Year',$Year);
&vv('$Sex',$Sex);
&vv('$Age',$Age);
&vv('$Height',$Height);
&vv('$Weight',$Weight);
&vv('$Dosuu1000',$Dosuu1000);
print OUT2 &en_sjis(join (',',$Year,$Sex,$Age,$Height,$Weight,$Dosuu1000)."\n"); # デバッグ用のTSV
#<>;
for (my $i3=1;$i3<=$Dosuu1000;$i3++) {
print OUT &en_sjis(join (',',$Year,$Sex,$Age,$Height,$Weight)."\n");
}
}
}
}
$i++;
}
close(OUT2);
}
#===============================
sub en_jis
{
my ($buf)=@_;
encode('iso-2022-jp',$buf);
}
sub de_jis
{
my ($buf)=@_;
decode('iso-2022-jp',$buf);
}
sub en_sjis
{
my ($buf)=@_;
encode('cp932',$buf);
}
sub de_sjis
{
my ($buf)=@_;
decode('cp932',$buf);
}
sub en_utf8
{
my ($buf)=@_;
encode('utf-8',$buf);
}
sub de_utf8
{
my ($buf)=@_;
decode('utf-8',$buf);
}
sub en_euc
{
my ($buf)=@_;
encode('euc-jp',$buf);
}
sub de_euc
{
my ($buf)=@_;
decode('euc-jp',$buf);
}
sub vv
{
my($Name,$Value)=@_;
if($debug) {
print $Name.'=['.$Value.']',"\n";
}
}
1;