読んだ。
COI：医局にあったので読んだ。地方小規模病院のなんちゃってクソ雑魚ICU医（）なので管理するのはIABPとVAECMOまでであるが、この本はVAD、Impellaのことまで実際のシナリオを交えながら、適応、管理、離脱まで（あくまで筆者施設のやり方で）記載されていて、参考になる。
もともと循環器内科医だけあって、AMIに対しての診断、治療、予後などの解説もあるので、AMI詳しくないです、という自分にとっても勉強になった。
ただひとつ気がかりなのが、シナリオで挿管が必要になったので「挿管します」ってさらっと書かれていたけど、循環器内科医ってそんなに挿管を簡単に決断、実行出来るの？
読んだ。
COI：評判よいらしいから買った。著者は全く知らない。循環とは、よく見るDO2 の式の酸素運搬と、組織灌流、すなわち脳還流などでよく見る脳血流=MAP - ICP のもの。
その他、筆者がものすごい好きなのだろうが、改定スターリングの法則とかグリコカリックスによる血管透過性などが語られていた。
この本で読むべきなのは、後半の血管作動薬、利尿薬の項で、こちらの方が実践的で明日からすぐ使える知識感が高かった。
R shiny で図を出力するのだが、図の大きさをinputで入力したとき、renderPlotの引数（widthとheight）にそれぞれ持たせようとすると、エラーになる。
状況としてはこんな感じである。
library(shiny) server <- function(input, output, session) { height <- as.numeric(input$imageHeight) width <- as.numeric(input$imageWidth) output$myplot <- renderPlot({ plot(iris) }, height=height, width=width) } ui <- fluidPage( numericInput("imageWidth", "図の幅", 480, min = 1, max = 2000), numericInput("imageHeight", "図の幅", 560, min = 1, max = 2000), mainPanel( plotOutput(outputId="myplot", height="auto") ) ) shinyApp(ui, server)
警告: Error in : Can't access reactive value 'imageHeight' outside of reactive consumer. ℹ Do you need to wrap inside reactive() or observe()? 55: <Anonymous> Error : Can't access reactive value 'imageHeight' outside of reactive consumer. ℹ Do you need to wrap inside reactive() or observe()?
outputにrenderPlotのオブジェクトを代入しようとしているが、renderPlot自体にはそれより先に作成されているはずのオブジェクト（height）はうまくなんやかんや出来ないらしい。
reactiveかobserveを使え、と言われている。
というわけで探したらあった。
Problem getting height of renderPlot to be reactive to number of questions plotted - #6 by WillP - shiny - RStudio Community
library(shiny) server <- function(input, output, session) { height <- reactive(input$imageHeight) # reactive width <- reactive(input$imageWidth) observe({ # observe output$myplot <- renderPlot({ plot(iris) }, height=height(), width=width()) # () と関数化されている }) } ui <- fluidPage( numericInput("imageWidth", "図の幅", 480, min = 1, max = 2000), numericInput("imageHeight", "図の幅", 560, min = 1, max = 2000), mainPanel( plotOutput(outputId="myplot", height="auto") ) ) shinyApp(ui, server)
出力されるhtml環境に合わせて図を拡大縮小しようとも思ったが、ブラウザのサイズ（というか図のサイズ）を定量的に保存しておきたいときに、ドラッグでブラウザのサイズを変えるのはよろしくないので採用できなかった。
Shiny でプロットの高さをブラウザ画面のサイズに合わせて変更する | Atusy's blog
そもそも図を描出するときに、Rだとdev.new(width=7, height=7)でプロットのためのキャンバスが登場するが、これをドラッグして拡大縮小したあとで、定量的にサイズ指定する方法がわからない。
拡大縮小したあとは、par()$dinでキャンバスの大きさを取得はできるが、par()$dinは読み取り専用で、任意の値の指定が出来ないので困っている。
https://www.rstudio.com/wp-content/uploads/2016/10/how-big-is-your-graph.pdf
Rの日付に関する関数で、
format(Sys.Date(), "%a")
とすると、日本語環境ならば
[1] "月"
これをR Shiny で使おうと思っていたら、shiny のサーバーは英語環境なので、デフォルトでは日月火水木金土が出てこず、英語表記のSun Mon... になってしまって罠にハマった。
環境を英語にしようと
Sys.setenv(LANG="en")
にしてみるが、これではうまく行かない。
困っていたら弟子に教えてもらったが
temp <- Sys.getlocale(category="LC_TIME") Sys.setlocale(category="LC_TIME", "C") format(Sys.Date(), "%a") Sys.setlocale(category="LC_TIME", temp)
[1] "C" [1] "Mon" [1] "ja_JP.UTF-8"
となり、英語化はうまくいった。
英語から日本語化は環境設定的にうまくいくのか確かめにくいので、面倒ではあるが、曜日番号を%u（月火水木金土日が1-7）もしくは%w（月火水木金土が1-6で、日が0）にして、月火水木金土日のオブジェクトを作って変換したほうが無難かもしれない。
書いた。
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()
