ナイチンゲール
この資料は、HistData をもとに作成しています。
HistData：統計とデータ可視化の歴史におけるデータセット
HistData パッケージは、統計とデータ可視化の歴史において興味深く重要な小規模データセットのコレクションを提供します。このパッケージの目的は、これらのデータセットを教育用途（例、問題集、プロジェクトなど）と歴史研究（過去の分析の拡張または批判）の両方で利用できるようにすることです。
多くのデータセットには、過去のグラフや分析を再現する例が含まれています。これらは主に、より広範な再分析やグラフによる精緻化のための出発点となることを目的としています。
これらは、統計史学（Friendly, 2007; Friendly & Denis, 2001; Friendly et-al, 2016）と呼ばれる研究プログラムの一部です。統計史学とは、統計とグラフィックの歴史における問題や疑問を統計的手法を用いて研究することを意味します。この研究の主要な側面は、グラフや分析を現代的な手法で再現しようとするプロセスを通して、科学とデータ分析における歴史的な問題への理解を深めることです。
1 HistData.
クリミア戦争における様々な死因に関するフローレンス・ナイチンゲールのデータ.
データビジュアライゼーションの歴史において、フローレンス・ナイチンゲールは社会運動家としての役割と、グラフや図表で提示された統計データが医療改革の強力な論拠となり得るという彼女の見解で最もよく知られています。
クリミア半島の劣悪な衛生状態を目の当たりにした彼女は、いくつかの影響力のある著作（Nightingale, 1858, 1859）を著しました。その中には、クリミア半島における戦闘による死亡者数と、戦場での看護ケアを改善することで軽減できる病気や予防可能な原因による死亡者数を比較した極座標グラフ（「コックスコーム」またはローズダイアグラムと呼ばれることもあります）も含まれています。
彼女が作成した「東部戦線におけるイギリス軍の死亡原因図」は、クリミア戦争中に戦死したイギリス兵のほとんどが、負傷やその他の原因ではなく、病気で死亡したことを示しています。また、1855年3月に衛生委員がキャンプと病院の衛生状態を改善するために到着する前、戦争の最初の年には死亡率がより高かったことも示されました。
2 ナイチンゲールのデータ.
＜準備＞.
- Google Colaboratory へようこそをクリック.
- 「ノートブックを開く」という画面になります.
- 「ノートブックを新規作成」をクリックします.
# ライブラリをロード
library(HistData)
library(ggplot2)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.1 ✔ stringr 1.5.1
## ✔ lubridate 1.9.4 ✔ tibble 3.2.1
## ✔ purrr 1.0.4 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors# データセットをロード
data(Nightingale)
# データの中身を確認
str(Nightingale)## 'data.frame': 24 obs. of 10 variables:
## $ Date : Date, format: "1854-04-01" "1854-05-01" ...
## $ Month : Ord.factor w/ 12 levels "Jan"<"Feb"<"Mar"<..: 4 5 6 7 8 9 10 11 12 1 ...
## $ Year : int 1854 1854 1854 1854 1854 1854 1854 1854 1854 1855 ...
## $ Army : int 8571 23333 28333 28722 30246 30290 30643 29736 32779 32393 ...
## $ Disease : int 1 12 11 359 828 788 503 844 1725 2761 ...
## $ Wounds : int 0 0 0 0 1 81 132 287 114 83 ...
## $ Other : int 5 9 6 23 30 70 128 106 131 324 ...
## $ Disease.rate: num 1.4 6.2 4.7 150 328.5 ...
## $ Wounds.rate : num 0 0 0 0 0.4 ...
## $ Other.rate : num 7 4.6 2.5 9.6 11.9 27.7 50.1 42.8 48 120 ...- Army：イギリス軍の推定平均月間兵力.
- Disease：予防または軽減可能な酵素疾患による死亡者数.
- Wounds：戦闘による直接の死亡者数.
- Other：その他の原因による死亡者数.
- Disease.rate：予防または軽減可能な酵素疾患による年間死亡率（1000人あたり）.
- Wounds.rate：戦闘による直接の死亡者数（1000人あたり）.
- Other.rate：その他の原因による年間死亡率（1000人あたり）.
3 死亡数.
data<- Nightingale[,c(1,5:6)]
data| Date | Disease | Wounds |
|---|---|---|
| 1854-04-01 | 1 | 0 |
| 1854-05-01 | 12 | 0 |
| 1854-06-01 | 11 | 0 |
| 1854-07-01 | 359 | 0 |
| 1854-08-01 | 828 | 1 |
| 1854-09-01 | 788 | 81 |
| 1854-10-01 | 503 | 132 |
| 1854-11-01 | 844 | 287 |
| 1854-12-01 | 1725 | 114 |
| 1855-01-01 | 2761 | 83 |
| 1855-02-01 | 2120 | 42 |
| 1855-03-01 | 1205 | 32 |
| 1855-04-01 | 477 | 48 |
| 1855-05-01 | 508 | 49 |
| 1855-06-01 | 802 | 209 |
| 1855-07-01 | 382 | 134 |
| 1855-08-01 | 483 | 164 |
| 1855-09-01 | 189 | 276 |
| 1855-10-01 | 128 | 53 |
| 1855-11-01 | 178 | 33 |
| 1855-12-01 | 91 | 18 |
| 1856-01-01 | 42 | 2 |
| 1856-02-01 | 24 | 0 |
| 1856-03-01 | 15 | 0 |
plot(data$Date,data$Disease,type="l",ylim=c(0,3000))
par(new=T)
plot(data$Date,data$Wounds,type="l",ylim=c(0,3000),col="red")
plot(data$Disease,data$Wounds)
cor(data$Disease,data$Wounds)## [1] 0.19439984 死亡率.
＜年間死亡率＞.
12 * 1000 * Death / Army で算出.
12ヶ月あたりで算出しているので、上限は1200 となる。
data<- Nightingale[,c(1,8:10)]
x <- data$Disease.rate+data$Wounds.rate+data$Other.rate
plot(data$Date,data$Disease.rate,type="l",ylim=c(0,1200),col="blue")
par(new=T)
plot(data$Date,data$Wounds.rate,type="l",ylim=c(0,1200),col="red")
par(new=T)
plot(data$Date,x,type="l",ylim=c(0,1200),col="black")
plot(data$Disease.rate,data$Wounds.rate)
ナイチンゲールがベースに用いたデータは戦後に陸軍がまとめたもので、記録された死者は約1.8万人、死因のトップは伝染病で約80%（1.47万人）、負傷による死者は約10%、そのほかが約10%だった。
80%の患者が敵兵の攻撃による直接的負傷による死ではなく、駐屯地での罹患や負傷後の院内感染による「伝染病」で死んだことは、「入院」が人を殺した側面がある。
5 コックスコム.
ナイチンゲールが作成した「鶏のとさか」（コックスコム）は、ポーラーエリアチャートと呼ばれる極座標グラフである。
Rの ggplot2パッケージととcoord_polar()関数を使って再現できる。
これは、Rに習熟してから挑戦してください。
5.1 準備.
GoogleColabでは、以下のコードをセルに入力し準備する必要があります。
＜パッケージのインストール＞.
install.packages(“HistData”)
install.packages(“ggplot2”)
install.packages(“tidyverse”)
install.packages(“reshape”)
＜パッケージの呼び出し＞.
library(HistData)
library(ggplot2)
library(tidyverse)
＜データセットをロード＞.
data(Nightingale)
str(Nightingale)
data(Nightingale)
# For some graphs, it is more convenient to reshape death rates to long format
# keep only Date and death rates
require(reshape)## Loading required package: reshape##
## Attaching package: 'reshape'## The following object is masked from 'package:lubridate':
##
## stamp## The following object is masked from 'package:dplyr':
##
## rename## The following objects are masked from 'package:tidyr':
##
## expand, smithsNight<- Nightingale[,c(1,8:10)]
melted <- melt(Night, "Date")
names(melted) <- c("Date", "Cause", "Deaths")
melted$Cause <- sub("\\.rate", "", melted$Cause)
melted$Regime <- ordered( rep(c(rep('Before', 12), rep('After', 12)), 3),
levels=c('Before', 'After'))
Night <- melted
# subsets, to facilitate separate plotting
Night1 <- subset(Night, Date < as.Date("1855-04-01"))
Night2 <- subset(Night, Date >= as.Date("1855-04-01"))
# sort according to Deaths in decreasing order, so counts are not obscured [thx: Monique Graf]
Night1 <- Night1[order(Night1$Deaths, decreasing=TRUE),]
Night2 <- Night2[order(Night2$Deaths, decreasing=TRUE),]
# merge the two sorted files
Night <- rbind(Night1, Night2)
require(ggplot2)
# Before plot
cxc1 <- ggplot(Night1, aes(x = factor(Date), y=Deaths, fill = Cause)) +
# do it as a stacked bar chart first
geom_bar(width = 1, position="identity", stat="identity", color="black") +
# set scale so area ~ Deaths
scale_y_sqrt()
# A coxcomb plot = bar chart + polar coordinates
cxc1 + coord_polar(start=3*pi/2) +
ggtitle("Causes of Mortality in the Army in the East") +
xlab("")
# After plot
cxc2 <- ggplot(Night2, aes(x = factor(Date), y=Deaths, fill = Cause)) +
geom_bar(width = 1, position="identity", stat="identity", color="black") +
scale_y_sqrt()
cxc2 + coord_polar(start=3*pi/2) +
ggtitle("Causes of Mortality in the Army in the East") +
xlab("")
if (FALSE) { # \dontrun{
# do both together, with faceting
cxc <- ggplot(Night, aes(x = factor(Date), y=Deaths, fill = Cause)) +
geom_bar(width = 1, position="identity", stat="identity", color="black") +
scale_y_sqrt() +
facet_grid(. ~ Regime, scales="free", labeller=label_both)
cxc + coord_polar(start=3*pi/2) +
ggtitle("Causes of Mortality in the Army in the East") +
xlab("")
} # }
## What if she had made a set of line graphs?
# these plots are best viewed with width ~ 2 * height
colors <- c("blue", "red", "black")
with(Nightingale, {
plot(Date, Disease.rate, type="n", cex.lab=1.25,
ylab="Annual Death Rate", xlab="Date", xaxt="n",
main="Causes of Mortality of the British Army in the East");
# background, to separate before, after
rect(as.Date("1854/4/1"), -10, as.Date("1855/3/1"),
1.02*max(Disease.rate), col=gray(.90), border="transparent");
text( as.Date("1854/4/1"), .98*max(Disease.rate), "Before Sanitary\nCommission", pos=4);
text( as.Date("1855/4/1"), .98*max(Disease.rate), "After Sanitary\nCommission", pos=4);
# plot the data
points(Date, Disease.rate, type="b", col=colors[1], lwd=3);
points(Date, Wounds.rate, type="b", col=colors[2], lwd=2);
points(Date, Other.rate, type="b", col=colors[3], lwd=2)
}
)
# add custom Date axis and legend
axis.Date(1, at=seq(as.Date("1854/4/1"), as.Date("1856/3/1"), "3 months"), format="%b %Y")
legend(as.Date("1855/10/20"), 700, c("Preventable disease", "Wounds and injuries", "Other"),
col=colors, fill=colors, title="Cause", cex=1.25)
# Alternatively, show each cause of death as percent of total
Nightingale <- within(Nightingale, {
Total <- Disease + Wounds + Other
Disease.pct <- 100*Disease/Total
Wounds.pct <- 100*Wounds/Total
Other.pct <- 100*Other/Total
})
colors <- c("blue", "red", "black")
with(Nightingale, {
plot(Date, Disease.pct, type="n", ylim=c(0,100), cex.lab=1.25,
ylab="Percent deaths", xlab="Date", xaxt="n",
main="Percentage of Deaths by Cause");
# background, to separate before, after
rect(as.Date("1854/4/1"), -10, as.Date("1855/3/1"),
1.02*max(Disease.rate), col=gray(.90), border="transparent");
text( as.Date("1854/4/1"), .98*max(Disease.pct), "Before Sanitary\nCommission", pos=4);
text( as.Date("1855/4/1"), .98*max(Disease.pct), "After Sanitary\nCommission", pos=4);
# plot the data
points(Date, Disease.pct, type="b", col=colors[1], lwd=3);
points(Date, Wounds.pct, type="b", col=colors[2], lwd=2);
points(Date, Other.pct, type="b", col=colors[3], lwd=2)
}
)
# add custom Date axis and legend
axis.Date(1, at=seq(as.Date("1854/4/1"), as.Date("1856/3/1"), "3 months"), format="%b %Y")
legend(as.Date("1854/8/20"), 60, c("Preventable disease", "Wounds and injuries", "Other"),
col=colors, fill=colors, title="Cause", cex=1.25)