高校数学の質問スレ（医者・東大卒専用） Part438

[過去ﾛｸﾞ] 高校数学の質問スレ（医者・東大卒専用） Part438 (1002ﾚｽ)
上下前次 1-新
通常表示 512ﾊﾞｲﾄ分割ﾚｽ栞

このｽﾚｯﾄﾞは過去ﾛｸﾞ倉庫に格納されています｡
次ｽﾚ検索歴削→次ｽﾚ栞削→次ｽﾚ過去ﾛｸﾞﾒﾆｭｰ

555: １３２人目の素数さん [sage] 2025/01/12(日) 10:55:46.68 ID:qiFin7nw

【臨床応用問題】
下記のデータから適合する分布を選びそのパラメータを算出せよ。
https://i.imgur.com/N9lQ4Qu.png

算出例

AICやBICで判定すると非負量を定義域にする分布ではWeibull分布が最良だった。
そのパラメータは
shape    scale
6.404264 1.551445
インフルエンザの潜伏期は形状母数k=2.0,尺度母数θ=1.0のガンマ分布(青色)に従うとする。
https://i.imgur.com/YAI1lc2.png

【臨床応用問題】
発熱外来では呼吸器症状を呈するインフルエンザと消化器症状を呈するノロウイルス感染に二分されたとする。
発熱外来で働く職員が同時に両方のウイルスに感染したときに同じ日に呼吸器症状と消化器症状が出現する確率を求めよ。

library(fitdistrplus)
set.seed(2025)
noro=c(
runif(2,0,24),
runif(2,25,28),
runif(16,29,32),
runif(16,33,36),
runif(14,37,40),
runif(2,41,44),
runif(5,45,48)
)/24
fit=fitdist(noro,'weibull') ; fit
gofstat(fit)
plot(fit)
hist(noro,freq=F,main="",col=4,breaks = 'scott')
fit$estimate
curve(dweibull(x,shape=fit$estimate[1],scale=fit$estimate[2]),add=TRUE,lwd=2)
par=fit$estimate ; par

Noro=rweibull(k,shape=par[1],scale=par[2])
plotPost(Noro,freq=FALSE,main='Norovirus',col=7)
curve(dweibull(x,shape=fit$estimate[1],scale=fit$estimate[2]),add=TRUE)

Flu=rgamma(k,shape=2,scale=1)
par(mfrow=c(3,1))
plotPost(Flu,col=4)
plotPost(Noro,col=2)
plotPost(Flu-Noro,col=7,compVal = 0)
mean(abs(Flu-Noro) < 1)

http://rio2016.5ch.net/test/read.cgi/math/1723152147/555

563: １３２人目の素数さん [sage] 2025/01/14(火) 18:27:07.83 ID:KQCqu9ZF

"
Fくんが２日前（４８時間とする）に喫食した食材でノロウイルスによる食中毒が発生したとする。
https://i.imgur.com/Aaz7iOi.png
のデータから現在無症状のFくんが今後、発症する確率を算出しなさい。
算出に必要な条件は適宜設定してよい。
"

rm(list=ls())
library(fitdistrplus)
solve=\(hours,distr=c("lnorm","gamma","weibull"),verbose=FALSE){
noro=c(
runif(2,21,24),
runif(2,25,28),
runif(16,29,32),
runif(16,33,36),
runif(14,37,40),
runif(2,41,44),
runif(5,45,48)
)
aic=NULL
for(i in 1:length(distr)) aic=c(aic,gofstat(fitdist(noro,distr[i]))$aic)
best_fit=distr[which.min(aic)]
fit=fitdist(noro,best_fit)
par=fit$estimate
if(verbose){
hist(noro,freq=F,main='Noro Virus incubation',col=4,axes=FALSE,xlab='hours',ylab='') ; axis(1)
curve(dgamma(x,par[1],par[2]),add=TRUE)
}
paste0('p',best_fit,'(hours,par[1],par[2],lower.tail = FALSE)') |> str2lang() |> eval()

}
solve(48,verbose=TRUE)

k=1e4
p48=replicate(k,solve(48,c("lnorm","gamma","weibull")))
round(HDInterval::hdi(p48),3)[1:2]
median(p48)
mean(p48)
BEST::plotPost(p48,showCurve = F,col='lightgreen',xlab='p[hour>48]')

http://rio2016.5ch.net/test/read.cgi/math/1723152147/563

581: １３２人目の素数さん [sage] 2025/01/17(金) 18:02:26.71 ID:BcOp0/e9

# incubation period for COVID-19
incu=\(x){dlnorm(x,m=1.64,s=0.58)
# lm=runif(1,1.6,1.8)
# s=runif(1,0.4,0.6)
}
incu=Vectorize(incu)
# window period for rapid antigen test
wind=\(x) dweibull(x, shape=2.5,scale=4.5)
wind=Vectorize(wind)
curve(wind,0,14,col=2,xlab='days',ylab='',axes=F) ; axis(1)
curve(incu,add=TRUE)
legend('top',bty='n',legend=c('incubation period','window period'),lty=1:1,col=1:2)

cdf_incu=\(x) integrate(incu,0,x)$value
cdf_incu=Vectorize(cdf_incu)
cdf_wind=\(x) integrate(wind,0,x)$value
cdf_wind=Vectorize(cdf_wind)
curve(cdf_wind,0,14,col=2)
curve(cdf_incu,add=TRUE)
legend('center',bty='n',legend=c('incubation period','window period'),lty=1:1,col=1:2)

pdfZ=\(z) integrate(\(x) incu(x)*wind(x-z),0,Inf)$value
pdfZ=Vectorize(pdfZ)
curve(pdfZ,-10,10,xlab='incubation-window (days)',axes=F,ylab='') ; axis(1)
integrate(pdfZ,-Inf,0)$value
fnr=\(x) integrate(pdfZ,-Inf,-x)$value # false negative rate after x days since onset of symtom
fnr=Vectorize(fnr)
curve(fnr,0,7, xlab='days after onset',ylab='false negative rate')

##
k=1e5
inc=rlnorm(k,m=1.64,s=0.58)
win=rweibull(k,shape=2.5,scale=4.5)
d=inc-win
hist(d)
mean(inc)
mean(win)
mean(inc<win) # negative test
re=NULL
for(i in 1:7) re=c(re,mean((inc+i)<win)) ; re
plot(re,pch=16)
which(re<0.05)[1]

http://rio2016.5ch.net/test/read.cgi/math/1723152147/581

上下前次 1-新書関写板覧索設栞歴

あと 407 ﾚｽあります
ｽﾚ情報赤ﾚｽ抽出画像ﾚｽ抽出歴の未読ｽﾚ AAｻﾑﾈｲﾙ

ぬこの手ぬこTOP 0.014s