Lifetable of J. Graunt

Data

Data Input

graunt <- data.frame(x = c(0, 6, 16, 26, 36, 46, 56, 66, 76), lx.17th = c(100, 64, 40, 25, 16, 10, 6, 3, 1))
  • 같은 연령대의 1993년 미국 생명표 입력
us.93 <- data.frame(x = graunt$x, lx.93 = c(100, 99, 99, 98, 97, 95, 92, 84, 70))
  • 두 자료를 합쳐서 하나의 데이터프레임으로
graunt.us <- data.frame(graunt, lx.93 = us.93$lx)
graunt.us
##    x lx.17th lx.93
## 1  0     100   100
## 2  6      64    99
## 3 16      40    99
## 4 26      25    98
## 5 36      16    97
## 6 46      10    95
## 7 56       6    92
## 8 66       3    84
## 9 76       1    70
  • Graunt 생명표로부터 개략의 생존함수 도시
plot(graunt$x, graunt$lx.17th, ann = F, xaxt = "n", yaxt = "n", type = "b")
axis(side = 1, at = graunt$x, labels = graunt$x)
axis(side = 2, at = graunt$lx.17th, labels = graunt$lx.17th)
abline(v = c(0, 76), lty = 2)

  • 기대수명 파악이 용이하도록 빗금
plot(graunt$x, graunt$lx.17th, ann=F, xaxt="n", yaxt="n", type="b")
axis(side = 1, at = graunt$x, labels = graunt$x)
axis(side = 2, at = graunt$lx.17th, labels = graunt$lx.17th, las = 2)
abline(v = c(0, 76), lty = 2)
graunt.x <- c(graunt$x, 0)
graunt.y <- c(graunt$lx.17th, 0)
# graunt.x <- c(graunt$x, rev(graunt$x))
# graunt.y<-c(rep(0, length(graunt$x)), rev(graunt$lx.17th))
polygon(graunt.x, graunt.y, density = 15)

  • 윤곽을 파악하기 쉽도록 격자 설정
plot(graunt$x, graunt$lx.17th, ann = F, xaxt = "n", yaxt = "n", type = "b")
axis(side = 1, at = graunt$x, labels = graunt$x)
axis(side = 2, at = graunt$lx.17th, labels = graunt$lx.17th, las = 2)
abline(v = c(0, 76), lty = 2)
graunt.x <- c(graunt$x, 0)
graunt.y <- c(graunt$lx.17th, 0)
polygon(graunt.x, graunt.y, density = 15)
abline(v = graunt$x, lty = 2)

  • 메인 타이틀과 x축, y축 라벨 설정.
# par(family = "Apple SD Gothic Neo")
plot(graunt$x, graunt$lx.17th, ann = F, xaxt = "n", yaxt = "n", type = "b")
axis(side = 1, at = graunt$x, labels = graunt$x)
axis(side = 2, at = graunt$lx.17th, labels = graunt$lx.17th, las = 2)
abline(v = c(0, 76), lty = 2)
graunt.x <- c(graunt$x, 0)
graunt.y <- c(graunt$lx.17th, 0)
polygon(graunt.x, graunt.y, density = 15)
abline(v = graunt$x, lty = 2)
# title(main = "John Graunt의 생존 곡선", xlab = "연령(세)", ylab = "생존률(%)")
title(main = "Survival Curve of Graunt's Life Table", xlab = "Age(years)", ylab = "Survived(%)")

1993년 미국의 생명표와 비교

plot(graunt$x, graunt$lx.17th, ann=F, xaxt="n", yaxt="n", type="b")
axis(side=1, at=graunt$x, labels=graunt$x)
axis(side=2, at=graunt$lx.17th, labels=graunt$lx.17th)
abline(v=c(0, 76), lty=2)
lines(us.93$x, us.93$lx.93, type="b")
axis(side=2, at=70, labels=70)
abline(h=70, lty=2)
text(x=66, y=95, labels="미국 1993년")

plot(graunt$x, graunt$lx.17th, ann = F, xaxt = "n", yaxt = "n", type = "b")
axis(side = 1, at = graunt$x, labels = graunt$x)
axis(side = 2, at = graunt$lx, labels = graunt$lx.17th, las = 2)
abline(v = c(0, 76), lty = 2)
# lines(us.93$x, us.93$lx.93, type = "b")
lines(graunt$x, us.93$lx.93, type = "b")
axis(side = 2, at = 70, labels = 70, las = 1)
abline(h = 70, lty = 2)
us.graunt.x <- c(graunt$x, rev(graunt$x))
us.graunt.y <- c(us.93$lx.93, rev(graunt$lx))
polygon(us.graunt.x, us.graunt.y, density = 15, col = "red", border = NA)
abline(v = graunt$x, lty = 2)
# title(main = "Graunt와 1993년 미국의 생존 곡선", xlab = "연령(세)", ylab = "생존률(%)")
title(main = "Survival Curve of Graunt's and US 93 Life Table", xlab = "Age(years)", ylab = "Survived(%)")

ggplot

str(graunt.us)
## 'data.frame':    9 obs. of  3 variables:
##  $ x      : num  0 6 16 26 36 46 56 66 76
##  $ lx.17th: num  100 64 40 25 16 10 6 3 1
##  $ lx.93  : num  100 99 99 98 97 95 92 84 70
library(reshape2)
?melt
graunt.melt <- melt(graunt.us, id.vars = "x", measure.vars = c("lx.17th", "lx.93"), value.name = "lx", variable.name = "times")
graunt.melt
##     x   times  lx
## 1   0 lx.17th 100
## 2   6 lx.17th  64
## 3  16 lx.17th  40
## 4  26 lx.17th  25
## 5  36 lx.17th  16
## 6  46 lx.17th  10
## 7  56 lx.17th   6
## 8  66 lx.17th   3
## 9  76 lx.17th   1
## 10  0   lx.93 100
## 11  6   lx.93  99
## 12 16   lx.93  99
## 13 26   lx.93  98
## 14 36   lx.93  97
## 15 46   lx.93  95
## 16 56   lx.93  92
## 17 66   lx.93  84
## 18 76   lx.93  70
str(graunt.melt)
## 'data.frame':    18 obs. of  3 variables:
##  $ x    : num  0 6 16 26 36 46 56 66 76 0 ...
##  $ times: Factor w/ 2 levels "lx.17th","lx.93": 1 1 1 1 1 1 1 1 1 2 ...
##  $ lx   : num  100 64 40 25 16 10 6 3 1 100 ...
levels(graunt.melt$times) <- c("17th", "1993")
str(graunt.melt)
## 'data.frame':    18 obs. of  3 variables:
##  $ x    : num  0 6 16 26 36 46 56 66 76 0 ...
##  $ times: Factor w/ 2 levels "17th","1993": 1 1 1 1 1 1 1 1 1 2 ...
##  $ lx   : num  100 64 40 25 16 10 6 3 1 100 ...
library(ggplot2)
g1 <- ggplot() + geom_point(data = graunt.melt, aes(x = x, y = lx, colour = times))
g1

g2 <- g1 + geom_line(data = graunt.melt, aes(x = x, y = lx, colour = times))
g2

g3 <- g2 + theme_bw()
g3

graunt.poly <- data.frame(x = graunt.melt[c(1:9, 18:10), 1], y = graunt.melt[c(1:9, 18:10), 3])
graunt.poly
##     x   y
## 1   0 100
## 2   6  64
## 3  16  40
## 4  26  25
## 5  36  16
## 6  46  10
## 7  56   6
## 8  66   3
## 9  76   1
## 10 76  70
## 11 66  84
## 12 56  92
## 13 46  95
## 14 36  97
## 15 26  98
## 16 16  99
## 17  6  99
## 18  0 100
g4 <- g3 + geom_polygon(data = graunt.poly, aes(x = x, y = y), alpha = 0.3, fill = "red")
g4

Starting with a different plot

  • 점들을 선으로 이어주기 위하여 geom_line()를 사용하면 원하지 않는 결과를 얻게 됨. geom_path()를 사용하여야 함.
p1 <- ggplot(graunt.poly, aes(x = x, y = y)) + geom_point() 
p1

p2 <- p1 + geom_path() 
p2

p3 <- p2 + geom_polygon(alpha = 0.3, fill = "red")
p3

p4 <- p3 + theme_bw()
p4

  • 타이틀과 자막에 한글을 넣는 방법은 다음 시간에^^