餡子付゛録゛

ソフトウェア開発ツールの便利な使い方を紹介。

結婚市場からの離脱を考慮した夫婦の社会的階層格差

f:id:uncorrelated:20160526172931p:plain

@kabutoyama_taro氏に、「ネット界隈が想起する"上昇婚"のイメージ」は・・・数学的にありえないと言われた*1のですが、ネット界隈の仮定に基づけばあり得るので、シミュレーションをして例示したいと思います。数式を書いて検証すると煩雑になりますし、「ありえない」ことを否定するには具体例を示せば十分なので*2

1. セットアップ

仮定は以下のようにします。社会的階層は順番で表現していますし、そう無理な仮定は置いていないと思います。ネット界隈の人が考えている一方で、@kabutoyama_taro氏が見落としているのは、ラベルを貼った【結婚市場からの離脱】と言う想定です。所謂、理想が高くて結婚できないケースです。

  • それぞれN人の男女がいる
  • 一夫一妻制
  • それぞれ1からN番目まで社会的階層による序列がついている
  • 序列番号の小さい順に男性が結婚していく。つまり、序列番号iの男性が結婚すると、序列番号i+1の男性が求婚をして回る
  • 男性は可能な限り社会的序列とは独立に定まる容姿が優れた女性と結婚したがる
  • 【結婚市場からの離脱】序列jの女性は、求婚してくる序列iの男性に対して、確率P(i/j)で結婚を承諾する

2. ソースコード

検証用に明示します。Nは300にしました。P(i/j)はプロビット分析などに準じて正規の累積分布関数を用いましたが、どのような分布でも大差は無いです。

set.seed(20160526)
N <- 300
beauty <- runif(N)
status_f <- rep(FALSE, N)
married <- numeric(N)

P <- function(a){
# iが小さいほど結婚を承諾される可能性が高いようにしている
  1 - pnorm(a)
}

for(i in 1:N){
  best_b <- 0
  best_f <- 0
  for(j in 1:N){
    if(!status_f[j] && P(i/j)>runif(1) && best_b < beauty[j]){
      best_f <- j
      best_b <- beauty[j]
    }
  }
  if(0 < best_f){
    status_f[best_f] <- TRUE
    married[i] <- best_f
  }
}

gap <- (1:N)[married>0] - married[married>0]

hist(gap, breaks=11, main=sprintf("それぞれ%d人の男女から%d組が婚姻", N, length(gap)), xlab="男性の序列番号 - 女性の序列番号", ylab="頻度", xlim=c(-N, N))
abline(v = mean(gap), lty=2)

3. 結果

f:id:uncorrelated:20160526170750p:plain

歪みは思ったような感じではありませんでしたが、平均値は-52.37959なので夫婦の階層格差が保存されています。また、男女それぞれ59人が結婚できていません。理由はあれこれ考えるまででも無く、【結婚市場からの離脱】が効いています*3。i/j<1ならば1、i/j>1ならば0を返す指示関数を確率関数にとれば、シミュレーションするまでもありません。
なお、男性が容姿ではなく社会的階層を女性に求めるように設定を変えると、夫婦の階層格差とその分散は一気に縮まる事になります*4。お見合いで家柄をあわせるような世界は、数理的に意味があったわけですね。

*1: Twitterで私が示した図の符号が間違って逆転していたので、修正しています。

*2: 現実にどうなっているかは、本稿の関心対象外なので悪しからず。

*3: 全員が結婚するのであれば、左右対称の分布になります。

*4: ソースコードは省略しますが、プロットすると以下のような結果になります。
f:id:uncorrelated:20160526171419p:plain