Theoretical Sociology

太郎丸博のブログです。研究ノートや雑感などを掲載しています。(このページは太郎丸が自主的に運営しています。京都大学の公式ページではありません。)
<< August 2017 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 >>
 
RECOMMEND
後期近代と価値意識の変容: 日本人の意識 1973-2008
後期近代と価値意識の変容: 日本人の意識 1973-2008 (JUGEMレビュー »)

NHKの日本人の意識調査のデータをつっこんで分析した本です。
RECOMMEND
Labor Markets, Gender and Social Stratification in East Asia: A Global Perspective (The Intimate and the Public in Asian and Global Perspectives)
Labor Markets, Gender and Social Stratification in East Asia: A Global Perspective (The Intimate and the Public in Asian and Global Perspectives) (JUGEMレビュー »)

直下の和書の英語版です。審査を通過するためにレフェリーのコメントに従って若干修正してあります。
RECOMMEND
東アジアの労働市場と社会階層 (変容する親密圏/公共圏)
東アジアの労働市場と社会階層 (変容する親密圏/公共圏) (JUGEMレビュー »)

GCOEの成果をまとめた本です。日本を中心に韓国、台湾(中国も少し)との比較研究をしてます。
RECOMMEND
若年非正規雇用の社会学‐階層・ジェンダー・グローバル化 (大阪大学新世紀レクチャー)
若年非正規雇用の社会学‐階層・ジェンダー・グローバル化 (大阪大学新世紀レクチャー) (JUGEMレビュー »)
太郎丸 博
拙著です。非正規雇用に関する本はたくさんありますが、「なぜ正規雇用と非正規雇用では賃金格差があるのか」など当たり前と思われがちな問題を突き詰めて考えてみました。
RECOMMEND
フリーターとニートの社会学
フリーターとニートの社会学 (JUGEMレビュー »)

拙編です。オーソドックスな計量社会学の手法で、若年非正規雇用や無職にアプローチした本です。白い装丁なので、輪郭がわからないですね...
RECOMMEND
人文・社会科学のためのカテゴリカル・データ解析入門
人文・社会科学のためのカテゴリカル・データ解析入門 (JUGEMレビュー »)
太郎丸 博
拙著です。軽く読み流すのは難しいですが、まじめに一歩一歩勉強するために作りました。
ARCHIVES
RECENT COMMENT
  • アマチュア社会学の可能性
    読者 (02/20)
  • 社会システム理論の野望、あるいは全体性へのオブセッション
    宮国 (12/19)
  • 片山他 2015「図書館は格差解消に役立っているのか?」
    オカベ (12/09)
  • ランダム効果の意味、マルチレベル・モデル、全数調査データ分析
    YZ (12/07)
  • 学歴社会から「学習資本」社会へ:日本の教育と社会における階級形成の再編
    赤尾勝己 (02/11)
  • グラフィカル・モデリングとは?
    anonymous (11/30)
  • Rスクリプト覚書き:vglm関数で平行性の仮定を置かずに順序ロジット
    ほっくー (08/05)
  • 台湾の経済: 典型NIESの光と影
    おーまきちまき (07/19)
  • ペルー移民は日本でどのように社会移動を経験するのか
    佐藤悟 (03/21)
  • ペルー移民は日本でどのように社会移動を経験するのか
    佐藤悟 (03/21)
RECENT TRACKBACK
 
スポンサーサイト

一定期間更新がないため広告を表示しています

- | | - | -
時代による平均値の変化のコーホート交代効果と個人変化効果への要因分解法のRスクリプト
時代による何らかの変数の平均値の変化(例えば、ジェンダー平等主義の高まり)は、コーホート交代によって生じたのか、それとも人々が自身の態度を変容させることによって生じたのか、明らかにしたい場合がある。そのような場合、Firebaugh (1997) の提唱する線形要因分解と代数的要因分解という方法がある。以下はその計算のための R スクリプトである。使っていただくのはかまわないが、引数の指定を間違っても警告やエラーメッセージなど出ないので、自己責任で注意して使っていただきたい。
### 以下がスクリプト ###
# 線形要因分解の関数
decompL <- function(period, formula, data, subset=NULL, weights=NULL){
  l1 <- lm(formula, data, subset=subset, weights=weights) # period は d1$year といった形で指定
  vars <- all.vars(formula)   # formula, data, subset, weights は通常のlm と同じように指定
  dat <- na.omit(data[, vars]) # data は必ず指定し、formula 中の変数は すべて data に含まれるようにする
  m1 <- by(dat, period, colMeans) # period 別に各変数の平均を計算
  dif <- (m1[[length(m1)]] - m1[[1]]) # 最後の時点の平均から最初の時点の平均を引く
  output <- dif[-1] * coef(l1)[-1] # 平均の差×係数
  output <- c(dif[1], sum(output), output) # 結果変数の実際の差、モデルから予測される差、各変数の効果
  names(output)[1] <- paste("Real Change of", names(dif)[1])
  names(output)[2] <- paste("Predicted Change of", names(dif)[1])
 return(as.matrix(output)) # 縦にならべて出力
}

# 代数的要因分解
decompA <- function(P, M, digits=3){ # P is a column percent matrix of a cohort-by-year crosstab
  nY <- ncol(P) # M is a mean matrix by cohort and year. M and P must have the same size.       ### Mの欠損値は必ず NA にしないと計算がおかしくなるので注意!!!
  nC <- nrow(P)
  output <- matrix(NA, 3, nY)  # 出力用の行列
  rownames(output) <- c("Cohort Replacement", "Individual Change", "Total")
  colnames(output) <- c(
                        paste(colnames(P)[-nY], "-", colnames(P)[-1], sep=""),
                        paste(colnames(P)[1], "-", colnames(P)[nY], sep="")
  )
  for(i in 1 : (nY - 1) ){
    Pi     <- P[, i : (i + 1) ] #比率に関して2時点の行列を作る
    dif.Pi <- Pi[, 2] - Pi[, 1] # 比率の差をとる
    m.Pi   <- (Pi[, 2] + Pi[, 1])/2 # 比率の平均をとる
    Mi     <- M[, i : (i + 1) ] # 2時点の平均の行列を作る
    Mi[is.na(Mi[, 1])==TRUE & is.na(Mi[, 2])==FALSE, 1] <- #NAをNAでない年の値で置換
                                Mi[is.na(Mi[, 1])==TRUE & is.na(Mi[, 2])==FALSE, 2]
    Mi[is.na(Mi[, 1])==FALSE & is.na(Mi[, 2])==TRUE, 2] <-
                                Mi[is.na(Mi[, 1])==FALSE & is.na(Mi[, 2])==TRUE, 1]    
    dif.Mi <- Mi[, 2] - Mi[, 1] # 平均の差
    m.Mi   <- (Mi[, 2] + Mi[, 1])/2 # 平均の平均
    sum1 <- function(x) sum(x, na.rm=T)
    output[1, i] <- sum1(m.Mi * dif.Pi) # コーホート交代効果
    output[2, i] <- sum1(m.Pi * dif.Mi) # 個人変化効果
    output[3, i] <- sum1(Pi[,2] * Mi[,2]) - sum1(Pi[,1] * Mi[,1]) # 総変化  
  }
  output[, nY] <- apply(output[,-nY], 1, sum)
  return(print(output, digits=digits))
}

スポンサーサイト
- | 15:56 | - | -
コメント
コメントする









 
トラックバック
この記事のトラックバックURL
http://sociology.jugem.jp/trackback/894
 

Copyright (C) 2004 paperboy&co. All Rights Reserved.

Powered by "JUGEM"