#!/usr/local/bin/jperl
########################################################
# SSM 95 職歴データ分析用ライブラリ
# 1996.09.04 - 
# 1997.04.02
# 	&hash_agew 計算方向を逆転
#	&age_fc, &age_lc 本人誕生月を利用 (&years_old 新設)
# 1998.09.13
#	&age_lc - &age_fc が初子-末子の年齢差を反映するよう &age_lc を修正
#		(該当者1名)
########################################################

########################################################
#	Read Configuration File
########################################################

while(<>){
	next if /^\s*$/;
	( /^\[(\w+)\]/ ) && ( $block=$1 ) && next;
	if( $block eq 'var' ){
		$Q{ (split(/\t/))[$[] } = ++$nvar;
	}elsif( $block eq 'output' ){
		chop;
		($key, $val) = split(/\t/) ;
		$para{$key} = $val;
	}elsif( $block eq 'miss' ){
		chop;
		($key, $val) = split(/\t/) ;
		$MISS{$key} = $val;
	}
}

########################################################
#	データ配列用意、欠損部分初期化
########################################################

for( $i=1+$para{'nvar'} ;  ($key,$val)=each(%MISS) ; ++$i ){
	$Q[$i]=$val;
	$Q{$val}=$i;
}

sub numerically{ $a<=>$b; }
$missmax = ( reverse sort numerically values(%MISS) )[$[] ;

%rmiss = reverse(%MISS) ;

########################################################
#	職歴配列初期化
########################################################

%WORK = (
	'P' , 'page' ,
	'W' , 'number' ,
	'A' , 'status' ,
	'C' , 'industry' ,
	'D' , 'size' ,
	'E' , 'job' ,
	'F' , 'post' ,
	'G' , 'start' 
) ;

foreach $N ( 1..17 ){
	foreach( keys %WORK ) {
		$Q = "Q7" . $_ . sprintf( "%02d" , $N ) ;
		$W{ $N, $WORK{$_} } = $Q{$Q};
	}
}

	# 職歴段欠損値に対応する構造体
foreach( values %MISS ) {
	$W{ $_ , 'page' }	= $Q{$_};
	$W{ $_, 'number'}	= $Q{$_};
	$W{ $_, 'status'}	= $Q{$_};
	$W{$_,'industry'}	= $Q{$_};
	$W{ $_ , 'size' }	= $Q{$_};
	$W{ $_ , 'job' }	= $Q{$_};
	$W{ $_ , 'post' }	= $Q{$_};
	$W{ $_ , 'start'}	= $Q{$_};
}

	# データ配列最後に、第0段職歴構造体もどきを追加
push( @Q, 0 );	$W{0, 'page'} = $#Q;
push( @Q, 0 );	$W{0, 'number'} = $#Q;
push( @Q, 9 );	$W{0, 'status'} = $#Q;
push( @Q, $MISS{'OUT'} );	$W{0, 'industry'} = $#Q;
push( @Q, $MISS{'OUT'} );	$W{0, 'size'} = $#Q;
push( @Q, $MISS{'OUT'} );	$W{0, 'job'} = $#Q;
push( @Q, $MISS{'OUT'} );	$W{0, 'post'} = $#Q;
push( @Q, 10 );	$W{0, 'start' } = $#Q ;

	# 年齢 -> 職歴段ハッシュの初期値
$agew_ini{0} = 0 ;
foreach( 10..70 ){ $agew_ini{$_} = $MISS{'YET'} ; }
foreach( values %MISS ) { $agew_ini{$_} = $_ ; }

	# -------- void &hash_agew();
	# 年齢 -> 職歴段ハッシュ %agew{10..70} 作成
	#	移動した年は、移動先 (時間的に最後のもの) をとる
sub hash_agew {
	%agew  = %agew_ini;	# 10..70 まで欠損値 YET で初期化
	unless( $Q[$Q{'DANSU'}] ) {	# ずっと無職
		foreach(10..$Q[$Q{'AGE'}]){ $agew{$_}=0; }
		return 0;
	}

	local( $i, $begin, $end ) ;
	$begin=10 ;	# 10才からはじめる
	for( $i=0 ; $i<$Q[$Q{'DANSU'}];  ++$i ){
		$end = $Q[$W{1+$i,'start'}] ;
		if( $missmax<$begin ) {
			if( $missmax<$end ){ foreach($begin..$end){ $agew{$_} = $i; } }
			else { foreach($begin..$Q[$Q{'AGE'}]){ $agew{$_}=$end; } }
		}
		$begin=$end ;
	}
		# 現職 ($begin=現職についた年齢; $i=DANSU)
	if( $missmax<$begin ) {
		foreach($begin..$Q[$Q{'AGE'}]){ $agew{$_}=$i; }
	}
	0;
}

	# -------- int &firstjob()
	# 返値： 初職の職歴段 (就業経験がなければ 0)
	#	例外処理だけのルーチン
sub firstjob {
	return 0  if 0==$Q[$Q{'DANSU'}] ;	# 就業経験なし
	foreach( 1 .. $Q[$Q{'DANSU'}] ){
		return $Q[$W{$_,'status'}]  if $Q[$W{$_,'status'}]<=$missmax ;
		return $_  if $Q[$W{$_,'status'}]<8 ;
	}
	return 0 ;
}

	# -------- int &fj_single()
	# 返値： 結婚前初職の職歴段 (初子出産が結婚より前ならそちらを優先)
	#	0: 結婚前には就業経験なし
	# 未婚者については初職をそのまま返す。
	# 婚姻上の地位 (MarStat) は85年と95年で 3,4 (離別・死別)が入れ替わっている。
	# 	ここでは 1 (未婚) かどうかだけを問題にするので、共通ルーチンで対処できる。
	# MarAge は、85年では初婚, 95年では現在の結婚である。
sub fj_single {
	local($fj) = &firstjob;
	return $fj	if $fj<=0 || 1==$Q[$Q{'MarStat'}] ;	# 欠損, 未経験, 未婚
	return $Q[$Q{'MarAge'}]	if $Q[$Q{'MarAge'}] <= $missmax;
	return $Q[$W{$fj,'start'}]	if $Q[$W{$fj,'start'}] <= $missmax;

	local($age_fc) = &age_fc;
	if(  0<$age_fc  && $age_fc<$Q[$Q{'MarAge'}] ) { 
		return $fj	if $Q[$W{$fj,'start'}] < $age_fc ;
	} else {
		return $fj	if $Q[$W{$fj,'start'}] < $Q[$Q{'MarAge'}] ;
	}
	0;
}

########################################################
#	DATA を読み出す。
########################################################

open( BINDATA, $para{'filename'} ) || die("Cannot open file $para{'filename'}") ;
binmode( BINDATA );

$Q[0] = '';	# $Q[0] は予約しておく (使わないか?)

########################################################
#	ループ中で呼ぶためのサブルーチン
########################################################

sub set_Q {
	printf STDERR "\r$N" ;
	@Q[1..$para{'nvar'}] = unpack( $para{'template'}, $record );
}

########################################################
#	単純集計出力用サブルーチン
########################################################

sub missconv{
	local(%V) = @_;
	foreach( keys %V ){ $V{$rmiss{$_}}=delete $V{$_} if( $_<=$missmax ) ; }
	return %V;
}
sub print_freq{
	local(%V) = @_;
	foreach( sort numerically keys %V ){ print "$_\t$V{$_}\n" ; }
	print "\n" ;
}
sub print_freqlist{
	local($f, %V) = @_;
	local($total, $cum) = ( 0,0 ) ;
	local(%missval, %misslabel) ;
	foreach( keys %V ){ 
		if( $_!~/\d/ ){ $misslabel{$_}++ ; } 
		elsif( $_<=$missmax ){ $missval{$_}++ ; }
		else { $total+=$V{$_} ; }
	}
	foreach( sort numerically keys %V ){
		if( $misslabel{$_} ) { &frprint( $f, $_, $V{$_} ) ; }
		elsif($missval{$_} ) { &frprint( $f, $rmiss{$_}, $V{$_} ) ; }
		else { &frprint( $f, $_, $V{$_}, 100*$V{$_}/$total, $cum+=$V{$_} , 100*$cum/$total ) ; }
	}
	&frprint( $f, "Total", $cum, 100*$cum/$total, "\n" ) ;
}
sub per{
	sprintf( "%5.1f", 100*$_[$[] );
}

sub class_freqlist {
	local($f, %V) = @_;
	local($total, $cum) = ( 0,0 ) ;
	local(%missval, %misslabel) ;
	local($x,$y,@x,@y,%x,%y) ;
	foreach( keys %V ){
		($x,$y) = split($;) ;
		++$x{$x};
		++$y{$y};
		if( $y!~/\d/ ){ $misslabel{$y}++ ; } 
		elsif( $y<=$missmax ){ $missval{$y}++ ; }
	}
	foreach( sort numerically  keys %x ){ push( @x, $_ ); }
	foreach( sort numerically  keys %y ){ push( @y, $_ ); }
	foreach $x ( @x ){
		$total = $cum = 0 ;
		printf( "\nX = %s\n", $x<=$missmax ? $rmiss{$x} : $x );
		foreach( @y ){
			$total+=$V{$x,$_} if( defined $V{$x,$_} && ! $misslabel{$_} && ! $missval{$_} ) ;
		}
		foreach( @y ){
			next unless defined $V{$x,$_} ;
			if( $misslabel{$_} ) { &frprint( $f, $_, $V{$x,$_} ) ; }
			elsif($missval{$_} ) { &frprint( $f, $rmiss{$_}, $V{$x,$_} ) ; }
			else{ &frprint( $f, $_, $V{$x,$_}, 100*$V{$x,$_}/$total, $cum+=$V{$x,$_}, 100*$cum/$total ); }
		}
		&frprint( $f, "Total", $cum, 100*$cum/$total, "\n" ) ;
	}
}

sub frprint {
	local($f, @list) = @_ ;
	foreach( @list ){
		if( ! /^\d/ ) { printf( "%${f}s" , $_ ) ; }
		elsif( $_ != int ) { printf( "%${f}.1f" , $_ ) ; }
		else{ printf( "%${f}d" , $_ ) ; }
	}
	printf( "\n" );
}

########################################################
#	学歴データ変換テーブル・関数
########################################################

	# 教育年数
%eduyear = (
	 1,	 6,
	 2,	 8,
	 3,	11,
	 4,	11,
	 5,	11,
	 6,	14,
	 7,	17,
	12,	 9,
	13,	12,
	14,	14,
	15,	16,
	16,	18,
) ;
foreach( values %MISS ) { $eduyear{$_} = $_ ; }

########################################################
#	年齢計算
########################################################

	# -------- int &years_old( int x );
	# 返値：x 〜 x+1 年前の本人年齢
	#	95年データの調査時の長子年齢などと本人年齢との差をとる。
	#	本人の誕生月情報を利用して精度をあげる。ただし結婚年が下限。
	# &age_fc, &age_lc から呼び出す
sub years_old {
	local($a) = $Q[$Q{'AGE'}]-$_[$[] ;	# 本人年齢との差をとる
	return $a	if $a==$Q[$Q{'MarAge'}]  ;	# 結婚年と同じならそのまま返す。
	return $a	unless 5<=$Q[$Q{'Q1_2M'}] && $Q[$Q{'Q1_2M'}]<=10 ;
	$a-1 ;	# 誕生月には欠損値はないはず。5〜10月生なら1をひく
}

	# -------- int &age_fc();
	# 返値：初子誕生時の本人年齢
sub age_fc {
	return $Q[$Q{'Q29_1'}]	if $Q[$Q{'Q29_1'}]<=$missmax ;	# 未婚/子供数不明
	return $Q[$Q{'Q29_2'}]	if $Q[$Q{'Q29_2'}]<=$missmax ;	# 子供なし/年齢不詳
	&years_old( $Q[$Q{'Q29_2'}] ) ;
}

	# -------- int &age_lc();
	# 返値： 末子誕生時の本人年齢
	#	子供がひとりのときは、初子誕生時年齢を代入
sub age_lc {
	local($age_fc) = &age_fc;	# 初子誕生時年齢
	return $age_fc	if 1==$Q[$Q{'Q29_1'}] ;	# ひとりっ子
	return $MISS{ 'DKNA' }	if $Q[$Q{'Q29_3'}]<=$missmax ;	# 子供複数 && 年齢不詳
	local($age_lc) = &years_old( $Q[$Q{'Q29_3'}] ) ;	# 末子誕生年
	return $age_lc if $age_fc<=$missmax ;	# 初子誕生年が不明ならそのまま返す
	return 1+$age_lc if	#1つ違いなのに同年になってしまうことのないように
		$age_fc==$age_lc &&
		$Q[$Q{'Q29_2'}] == $Q[$Q{'Q29_3'}] +1;
	$age_lc;
}

########################################################
#	end
########################################################

1;