2021-01-07

高水準関数の作図後に低水準関数で作図したときの線の扱いをなんとかしたい

意味的にはこんな感じである。
plotで作図すると高水準関数といって、とりあえず作図されるが、その後に低水準関数と呼ばれる、例えばpointsやlineといった関数で後付でお絵描きができる。
自分がよくやるのはplotしたあとに、ある領域はこうである、みたいな色付けをpolygon関数でやるのだが、何も考えないでplotのあとにpolygonを行うとこんな感じになる。

d <- 0.5
plot(1, xlab="", ylab="")
box(lwd=10)
pa <- par()$usr
polygon(c(pa[1]+d, pa[2]-d, pa[2]-d, pa[1]+d), rep(pa[3:4], each=2), border=NA, col=grey(0.8))

f:id:MikuHatsune:20210107143612p:plain
box関数で枠の太さを水増ししているが、要はpolygonで作図した線がplotで定義されている枠線のちょうど真ん中を通るように設計されているので、polygonがレイヤーでいうところの最上位に来ていてこんな感じのなんか気持ち悪い感じになる。

これを解決してpolygonが下に来てplotの枠線が上に来るようにするには、それはそうするしかない。が、普通にboxで後付けするとplotで描かれる枠線とかぶって更に気持ち悪くなる。
というわけでplotするときに、不要なものやあとで付け足したいものは引数で描かないように設定する。

plot(1, xlab="", ylab="", frame=FALSE, xaxt="n", yaxt="n")
axis(1, lwd=0, lwd.ticks=1)
axis(2, lwd=0, lwd.ticks=1)
polygon(c(pa[1]+d, pa[2]-d, pa[2]-d, pa[1]+d), rep(pa[3:4], each=2), border=NA, col=grey(0.8))
box(lwd=10)

f:id:MikuHatsune:20210107143950p:plain

2020-12-26

メタアナリシスっぽいので公平な入試を受けたい　令和2年版

R Rpackage Rを使いこなす医学数学いらずの医科統計学

この記事はR Advent Calendar 2020 - Qiitaの24日の配当記事です（書くネタなかったけど無理やりこじつけた
メタアナリシスの解析にmeta パッケージを使っています。

令和2年版の調査結果というものを観測した。
医学部医学科の入学者選抜における公正確保等に係る調査について：文部科学省

いままでと同じようにやってみる。
mikuhatsune.hatenadiary.com
mikuhatsune.hatenadiary.com

結論から言うと男性が1.1倍程度合格しやすいようである。
f:id:MikuHatsune:20201226002714p:plain

library(meta)
dat <- read.csv(text="
大学,男性受験者数,男性合格者数,女性受験者数,女性合格者数
北海道大学, 266,  89, 77, 25
旭川医科大学, 336, 224, 66, 37
弘前大学, 225, 155, 66, 46
東北大学, 294, 109, 89, 32
秋田大学, 253, 185, 82, 48
山形大学, 212, 179, 63, 44
筑波大学, 238, 208, 91, 49
群馬大学, 205, 130, 82, 35
千葉大学, 260, 116, 90, 39
東京大学, 271,  67, 81, 20
東京医科歯科大学, 244, 130, 73, 43
新潟大学, 297, 121, 93, 30
富山大学, 218, 165, 54, 52
金沢大学, 204,  70, 89, 24
福井大学, 205, 145, 75, 40
山梨大学, 274,  88,111, 32
信州大学, 219, 164, 71, 55
岐阜大学, 369, 149, 76, 29
浜松医科大学, 213, 141, 78, 42
名古屋大学, 206, 101, 79, 32
三重大学, 213, 124, 83, 42
滋賀医科大学, 169, 133, 45, 51
京都大学, 215,  64, 91, 17
大阪大学, 235,  76, 84, 17
神戸大学, 164,  96, 71, 41
鳥取大学, 398, 250, 66, 39
島根大学, 272, 238, 59, 45
岡山大学, 242, 169, 65, 46
広島大学, 335, 154, 81, 39
山口大学, 295, 155, 70, 38
徳島大学, 125,  75, 73, 45
香川大学, 264, 219, 69, 45
愛媛大学, 318, 277, 57, 58
高知大学, 271, 238, 69, 44
九州大学, 200,  55, 91, 20
佐賀大学, 229, 149, 60, 43
長崎大学, 223, 125, 85, 36
熊本大学, 358, 179, 79, 33
大分大学, 255, 196, 61, 41
宮崎大学, 179, 147, 69, 45
鹿児島大学, 233, 154, 72, 40
琉球大学, 229, 156, 64, 50
札幌医科大学, 249, 124, 81, 31
福島県立医科大学, 207, 138, 89, 48
横浜市立大学, 130, 110, 58, 42
名古屋市立大学, 135,  98, 61, 37
京都府立医科大学, 158,  80, 79, 29
大阪市立大学, 145,  90, 70, 25
奈良県立医科大学, 435, 264, 84, 40
和歌山県立医科大学, 131,  47, 78, 23
岩手医科大学,1620, 836,190, 72
東北医科薬科大学,1060, 522,228, 97
自治医科大学,1604,1030, 75, 48
獨協医科大学,2081,1310,179, 94
埼玉医科大学,2753,1972,144,105
国際医療福祉大学,2018,1769,230,161
杏林大学,1916,1267,110, 81
慶應義塾大学, 841, 332,123, 44
順天堂大学,2164,1607,200,125
昭和大学,2438,1661,166,119
帝京大学,5263,3607,182,125
東京医科大学,1454, 923,183,107
東京慈恵会医科大学,1251, 549,288,114
東京女子医科大学,NA,1478,NA,343
東邦大学,1484,1121, 69, 61
日本大学,1784,1160,128, 66
日本医科大学,2250,1470,324,220
北里大学,1241, 755,182, 97
聖マリアンナ医科大学,1169, 965, 71, 96
東海大学,2608,1838,146, 87
金沢医科大学,2789,1725,128,109
愛知医科大学,2084,1370,226,130
藤田医科大学,2041,1233,210,120
大阪医科大学,1681,1043,126, 86
関西医科大学,2239,1591,354,223
近畿大学,2060,1353,159, 85
兵庫医科大学,1155, 912,137,123
川崎医科大学,1034, 623, 71, 55
久留米大学,1949,1100,127, 71
産業医科大学, 928, 621, 76, 46
福岡大学,2233,1363,110, 65"
)

b <- metabin(女性受験者数, 男性受験者数, 女性合格者数, 男性合格者数, data=dat, sm="OR", studlab=大学, comb.fixed=TRUE, comb.random=TRUE, label.e="男性", label.c="女性")

alpha <- 0.05
cols <- ifelse(b$pval < alpha, ifelse(b$TE < 0, "red", "blue"), "black")

forest(b, label.right="男性有利", label.left="女性有利",
       col.label.right="blue", col.label.left="red",
       col.study=cols, lwd=2)