書いた。
Asymptomatic Hypoxemia as a Characteristic Symptom of Coronavirus Disease: A Narrative Review of Its Pathophysiology. COVID 2022, 2(1), 47-59.
COVID-19において、低酸素血症なのにぜんぜん苦しそうにない、いわゆるhappy hypoxia もしくはsilent hypoxia と言われている現象の総説である。
COVID-19罹患時に限らず、いわゆる低酸素応答とは、みたいなことも概説してあるので興味があれば。
査読で「日本の感染者数だけではなく世界について語って」みたいなことを言われたのでデータを探したら、Google のトップページでもこれを基に図を作っている、という元データがあった。
Coronavirus (COVID-19) Testing - Statistics and Research - Our World in Data
GitHub - owid/covid-19-data: Data on COVID-19 (coronavirus) cases, deaths, hospitalizations, tests • All countries • Updated daily by Our World in Data
国別のPCR陽性者数、検査数、死亡者数などいろいろあって、かつ国が大陸ごとにラベル付けられていたのでこれを使った。
library(xts) url <- "https://covid.ourworldindata.org/data/owid-covid-data.csv" dat <- read.csv(url, check.names=FALSE, stringsAsFactors=FALSE) dat$date <- as.Date(dat$date) Month <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") y1 <- as.numeric(format(dat$date[1], "%Y")) y1 <- as.Date(sprintf("%s-01-01", format(dat$date[1], "%Y"))) s <- as.numeric(mapply(format, dat$date[1], c("%Y", "%m")) t0 <- c( c(mapply(function(z) tapply(z$new_cases, z$date, sum, na.rm=TRUE), split(dat, dat$continent))), Japan=mapply(function(x) tapply(x$new_cases, x$date, sum), list(subset(dat, location=="Japan")), SIMPLIFY=FALSE) ) d <- as.Date(names(t0[[which.max(sapply(t0, length))]])) t1 <- mapply(function(z) replace(rep(NA, length(d)), match(names(z), as.character(d)), z), t0) rownames(t1) <- d t1[, c(colnames(t1)=="")] <- rowSums(t1[, colnames(t1) != "" & colnames(t1) != "Japan"], na.rm=TRUE) colnames(t1)[c(colnames(t1)=="")] <- "World" t2 <- ts(t1, start=c(s[1], dat$date[1]-y1), frequency=365) t7 <- apply(t1, 2, filter, rep(1, 7))/7 emg_state <- lapply(list(c("2020-04-07", "2020-05-25"), c("2021-01-08", "2021-03-07"), c("2021-04-25", "2021-06-20"), c("2021-07-12", "2021-09-30")), as.Date) m <- as.numeric(format(d, "%m")) m0 <- rle(m) m1 <- c(1, cumsum(m0$lengths)) Y <- as.numeric(format(d, "%Y")) Y0 <- rle(Y) Y1 <- c(1, cumsum(Y0$lengths)) # svg("figure.svg", 1200/96, 800/96) cols <- c("black", "#0000FF", "#00FFFF", "green2", "yellow3", "orange", "#FF0000", "white") names(cols) <- colnames(t2) xl <- range(d) + c(1, -1) * 20 w7 <- 100000 par(mfrow=c(2, 1), mar=c(5, 6, 1, 1), las=1) plot(d, t7[,1]/w7, type="n", lwd=10, las=1, xlab="", ylab="", cex.axis=1.2, xaxt="n", yaxt="n", xlim=xl, ylim=c(0, 10), frame=FALSE) pa <- par()$usr # d1 <- c(pa[1], d, pa[2]) d1 <- as.numeric(c(d, pa[2])) x1 <- (head(d1[m1], -1) + tail(d1[m1], -1))/2 # axis(1, at=d1[m1[-1]], labels=NA) axis(1, at=d1[m1], labels=NA) ats <- seq(0, 10, 2); axis(2, at=ats, cex.axis=1.5) abline(h=ats, lty=3) for(i in seq(ncol(t7)-1)){ lines(d, t7[,i]/w7, col=cols[i], lwd=7) lines(d, t2[,i]/w7, col=cols[i], lwd=2) } for(i in seq(x1)){axis(1, at=x1[i], labels=Month[m0$values][i], tick=FALSE, cex.axis=1.2)} y1 <- c(pa[1], head(d[cumsum(Y0$lengths)], -1), pa[2]) xd <- 5 yd <- pa[3]-1.75 for(i in 1:(length(y1)-1)){ segments(y1[i]+xd, yd, y1[i+1]-xd, xpd=TRUE, lwd=2) axis(1, at=mean(y1[c(i, i+1)]), labels=Y0$values[i], line=2, tick=FALSE, cex.axis=1.2) #text(mean(y1[c(i, i+1)]), yd, Y0$values[i], adj=c(0.5, 2), xpd=TRUE) } axis(1, at=pa[1], labels="Month", las=1, cex.axis=1, tick=FALSE, line=0, hadj=1, cex.axis=1.2) axis(1, at=pa[1], labels="Year", las=1, cex.axis=1, tick=FALSE, line=2, hadj=1, cex.axis=1.2) legend("topleft", legend=head(names(cols), -1), pch=15, col=cols, cex=1.5) box() #mtext("Time", 1, line=5, cex=1.5) mtext(substitute("Positive cases ["*10^x*"]", list(x=log10(w7))), 2, line=3, cex=2, las=3) w2 <- 10000 plot(d, t2[,"Japan"]/w2, type="n", lwd=5, las=1, xlab="", ylab="", cex.axis=1.2, xaxt="n", yaxt="n", xlim=xl, ylim=c(0, 3), frame=FALSE, cex.axis=1.5) xi <- c(1, 2, 2, 1); yi <- c(3, 3, 4, 4) pa <- par()$usr d1 <- as.numeric(c(d, pa[2])) axis(1, at=d1[m1], labels=NA) ats <- seq(0, 3, 1); axis(2, at=ats, cex.axis=1.5) abline(h=ats, lty=3) for(i in seq(emg_state)){polygon(emg_state[[i]][xi], pa[yi], border=NA, col=grey(0.9))} lines(d, t2[,"Japan"]/w2, col="black", lwd=2) lines(d, t7[,"Japan"]/w2, col="black", lwd=7) x1 <- (head(d1[m1], -1) + tail(d1[m1], -1))/2 for(i in seq(x1)){axis(1, at=x1[i], labels=Month[m0$values][i], tick=FALSE, cex.axis=1.2)} y1 <- c(pa[1], head(d[cumsum(Y0$lengths)], -1), pa[2]) xd <- 5 yd <- pa[3]-0.5 for(i in 1:(length(y1)-1)){ segments(y1[i]+xd, yd, y1[i+1]-xd, xpd=TRUE, lwd=2) axis(1, at=mean(y1[c(i, i+1)]), labels=Y0$values[i], line=2, tick=FALSE, cex.axis=1.2) #text(mean(y1[c(i, i+1)]), yd, Y0$values[i], adj=c(0.5, 2), xpd=TRUE) } axis(1, at=pa[1], labels="Month", las=1, cex.axis=1, tick=FALSE, line=0, hadj=1, cex.axis=1.2) axis(1, at=pa[1], labels="Year", las=1, cex.axis=1, tick=FALSE, line=2, hadj=1, cex.axis=1.2) mtext(substitute("Positive cases ["*10^x*"]", list(x=log10(w2))), 2, line=3, cex=2, las=3) box() # dev.off()
