この答えは、単純には、以下のとおりでした。
なんとなく、これが正しいとすれば、明らかに40歳以上の人の感染数が多いように見えます。
しかし、人口分布を加味すると、感染率は以下のようになりました。
「全期間の平均では、90代の高齢者を除いてほぼ一定の感染率となり、若干20－30代の若年層の感染率が高いという結果になりました。」
ということで、R言語を駆使して、この命題の答えを求めて今回も悪戦苦闘しましたが結果だけ記述します。
今回もR言語初心者で感染症の素人分析なので、結果のご判断は自己責任でお願いします。
やったこと
・分布の変化
・日本の人口ピラミッドで校正
・分布の変化
実は上記の分布は、以下の参考の東京都の感染番号1-154までの人の年齢分布を示しています。
【参考】
・東京都_新型コロナウイルス陽性患者発表詳細
上記のサイトのデータを見れば分かりますが、1-154は日本の感染数の増加の傾きが大きく変わる直前の3月23日までのデータです。つまり、少なくともこの時期までは、40歳以上の人の感染数が多かったことが分かります。
次に示すのは、全体の分布です。つまり、1月24日から5月8日で4810人分を年齢でカテゴライズした頻度グラフです。以下を見ると、明らかにグラフのピークが20歳代に移動しています。
平均も50歳以上から、45歳まで若返っています。
ここで両曲線に付随している赤い線は、正規分布としてデータの平均と標準偏差に基いて描画しています。
※当初は検定しようかなと思っていましたが今回はパスします
じゃ、どのように分布変化が起こっているのかを、少し期間を動かしつつ見てみましょう。
1001-1500（4／5-4／9）30代と20代が増えました。
1501-2000(4／9－4／12)さらに20代と40代、50代が増えました。
3001－4000（4／19－4／28）ついに20代がトップになりました。
4001－4800（4／28－5／8）一番最近のデータは若年層が多めですが、ほぼ全年齢層に徐々に減少しています。つまり、当初若年層は感染数低いとか言っていたのは様変わりしています。
・日本の人口ピラミッドで校正
感染率を議論するなら、やはり人口分布を見る必要があります。
人口分布は以下で提供されていました。
【参考】
・トップ > 東京都の人口予測トップページ > 東京都男女年齢（５歳階級）別人口の予測トップページ > 統計データ
第９表 区市町村、男女、年齢(５歳階級)別将来人口 Excel(区市町村別一覧へ) ／ CSV一括DL(282KB)
これを男女合計の頻度グラフにすると以下のとおりです。
やはり、40代が一番多いんですね。高齢者多いと言っても、やはり80代以上は少ないですね。
そして、何より20歳未満が少ないです。
ということで、この人口ピラミッドで上記の感染数分布を校正します。
校正しても、当初は高齢者60代の感染率が高かったと言えます。
しかし、すぐに様相は一変しました。これだと、20－30代の若年層が感染率が高くなっています。
そして、この時点だと高齢者は幾分減少したように見えます。
1001-1500（4／5-4／9）
ところが、以下の期間になると急激に90代以上の感染率が増加しました。
いよいよ、介護や院内感染が増えたのでしょう。
1501-2000(4／9－4／12)
この時期は90代の高齢者を除いて、ほぼ全年齢層で感染率はほぼ一定になりました。
3001－4000（4／19－4／28）
最近の傾向は感染率は全年齢でほぼ一定です。
そして高齢者の感染率が増加しているようです。
4001－4800（4／28－5／8）
そして、全期間の平均では、90代の高齢者を除いてほぼ一定の感染率となり、若干20－30代の若年層の感染率が高いという結果になりました。
1－4800（1／24－5／8）
まとめ
・東京のコロナ感染数を人口分布で校正して感染率で比較してみた
・感染率は90代の高齢者を除いてほぼ一定となった。若干20－30代が大きめである。
・得られた結果の信頼性について評価したい
おまけ
コードを掲載しておきます。
data <- read.csv("population_tokyo.csv")
data_total <- subset(data,data$性別コード==0 & data$年齢階級区分!="total")
pop <- data_total$X2020年
age <- data_total$年齢階級区分
l1<-c()
l2<-c()
for (k in 1:18) {
if (!k %% 2)
next
b<-pop[k]+pop[k+1]
l2<-c(l2,b)
l1<-c(l1,age[k])
}
b<-pop[19]
l2<-c(l2,b)
l1<-c(l1,age[19])
barplot(l2,names.arg=c(l1))
title(main = "Histgram of population in Tokyo",xlab="age",ylab="population")
a=1501
b=2000
data <- read.csv("tokyo_covid19_patients.csv")
data500 <- subset(data,data$No==a:b & data$患者_年)
age <- data500$患者_年
x <- seq(0,110,10)
hist(age,breaks = x,main="")
title(main = "Histgram of COVID")
mean_age=round(mean(age),digits=2)
sigma_age=round(sqrt(var(age)),digits=2)
legend("topright",legend=c(a," |",b,"mean",mean_age,"σ",sigma_age))
lines(x, (b-a)*10*dnorm(x, mean=mean_age, sd=sigma_age), col="red",lwd=2)
cx=table(data500$患者_年)
l3 <- c()
ci=1
for (i in cx) {
l3[ci]=i
ci = ci+1
}
l3[ci]=0
l4 <- c()
for (i in 1:10) {
l4[i]=1000000*l3[i]/l2[i]
}
barplot(l4)
title(main = "Histgram of COVID",xlab="age",ylab="cases per million")
mean_value=round(mean(l4),digits=2)
sigma_value=round(sqrt(var(l4)),digits=2)
legend("topleft",legend=c(a," |",b,"μ",mean_value,"σ",sigma_value))