COVID-19 の潜伏期間をrstanで推定する - 驚異のアニヲタ社会復帰の予備の紹介で知った。
https://docs.google.com/spreadsheets/d/1jS24DjSPVWa4iuxuD4OAXrE3QeI8c9BC1hSlqr-NMiU/edit#gid=1449891965に，感染者が新型コロナウイルスのある地域への暴露を開始した日付と終了した日付，発症した日付が記録されている。
ここから新型コロナウイルスの潜伏期間を推定できるだろうか。
感染した日はわからないが，暴露を開始した日付と終了した日付の間のどこかに落ちる。
患者 が発症した日を原点 0 として, 暴露が終了した日を
日前とする。 暴露が終了した日からさかのぼって
日前が感染した日だとする。
この記法のもとで，もし感染した日がわかっている完全な観測が得られた場合, 発症までの待ち時間の確率密度は である。
いま は未観測なので積分消去する。
感染者 が新型コロナウイルスのある地域へ暴露していた期間を
とすると，ある患者
の観測についての尤度は,
である。をあらためて
とおくとこの積分は
と書き換えられる。
これは，生存時間分析の分野で区間打ち切りとよばれる観測と同じ。
区間打ち切りされたデータからノンパラメトリックに生存関数（1引く分布関数）を求める方法はすでに提案されており, R では survival パッケージで提供されている。
で以前に作った関数群で新型コロナウイルスの感染履歴データを視覚化してみる。
半透明の帯は95%信頼区間。
エラーバーは95%区間（2.5パーセンタイルから97.5パーセンタイル）。だいたい2日から19日。
WHOの見積もった潜伏期間（新型コロナウイルスに関するQ&A（一般の方向け）｜厚生労働省）1〜12.5日より右によってる。
library(survival)library(tidyverse)library(tidysurv)library(readxl)library(cowplot) ct <- rep("guess",23) ct[8]<-"numeric" ct[c(3,9,11,14,15,19,20,21)]<-"date"#データは冒頭のリンク data_new <- read_excel("~/Downloads/Kudos to DXY.cn Last update_ 03_13_2020, 8_00 PM (EST).xlsx",sheet =1,skip =1, col_types= ct) data_new2 <- data_new %>% dplyr::filter(!is.na(symptom_onset)&!is.na(exposure_end))%>% mutate(exposure = as.integer(as.Date(exposure_end)-as.Date(exposure_start)), incubation = as.integer(as.Date(symptom_onset)- as.Date(exposure_end)))%>% dplyr::filter(incubation >0)#生存関数の推定はこの1行をかくだけ sf1 <- survfit(Surv(time=incubation,time2=exposure+incubation, type="interval2")~1, data=data_new2) dfsf <- tidysurv(sf1) ggplot(dfsf,aes(x=time,y=survival,ymin=lower,ymax=upper))+ geom_line()+ geom_ribbon(alpha=0.3) bw <-2.0 dfh <- make_hdf(sf1,bw) qdf <- make_qdf(sf1,probs=c(0.025,0.975)) ggplot(dfh)+ geom_col(aes(x=midtime,y=density),width = bw)+ geom_errorbarh(data=qdf,aes(xmin=`q 2.5`,xmax=q97.5,y=-0.01,height=0.01))+ xlim(c(-0.1,NA))+labs(colour="")
参考文献はなに貼るか迷うな。
とりあえずこれにしとくが，めっちゃおすすめというわけでもない。
- 作者:J.P. クライン,M.L. メシュベルガー
- 発売日: 2012/02/29
- メディア:単行本
パラメトリックにやる場合には次のようにする：