Data and methods
- Target area and regional unit: 47 Prefectures in Japan
- Target periods: from week 6 to week 12 in 2020
- Week 06: 2.3 - 2.9
- Week 07: 2.10 - 2.16
- Week 08: 2.17 - 2.23
- Week 09: 2.24 - 3.1
- Week 10: 3.2 - 3.8
- Week 11: 3.9 - 3.15
- Week 12: 3.16 - 3.22
- Visualize by NippomMap
Libraries and my function
> #install.packages("readr")
> #install.packages("dplyr")
> #install.packages("tidyr")
> #install.packages("magrittr")
> #install.packages("sp")
> #install.packages("scanstatistics")
> #install.packages("classInt")
> #install.packages("RcolorBrewer")
> #install.packages("NipponMap")
> #install.packages("animation")
>
> library(readr)
> library(dplyr)
> library(tidyr)
> library(magrittr)
> library(sp)
> library(scanstatistics)
> library(classInt)
> library(RColorBrewer)
> library(NipponMap)
> library(animation)
>
>
> findc2 <- function(dat,bk,col){
+ rtn <- rep(col[1],length(dat))
+ for(i in 1:length(dat)){
+ for(j in 2:(length(bk)-1)){
+ if(bk[j]<=dat[i]){
+ rtn[i] <- col[j]
+ }
+ }
+ }
+ rtn
+ }
Class Intervals
> JPN_popcov <- read_csv("JPN_popcov6to12.csv", locale = locale(encoding = "SHIFT-JIS"))
> tail(JPN_popcov, 5)
# A tibble: 5 x 4
week pref pop count
<dbl> <chr> <dbl> <dbl>
1 12 43.Kumamoto-ken 17.6 1
2 12 44.Oita-ken 11.4 20
3 12 45.Miyazaki-ken 10.8 2
4 12 46.Kagoshima-ken 16.1 4
5 12 47.Okinawa-ken 14.5 0
> counts <- JPN_popcov %>%
+ filter(week >= 6 & week <= 12) %>%
+ df_to_matrix(time_col = "week", location_col = "pref", value_col = "count")
>
> nclass <- 6
> cls <- classIntervals(as.numeric(counts), nclass, style = "jenks")
> rdpu6 <- brewer.pal(nclass,"RdPu")
Only week 6
> colors <- findc2(counts[1,],cls$brks, rdpu6)
> colors[which(counts[1,]==0)] <- "#FFFFFF"
> par(mar=c(2,2,2,2))
> main <- paste("Covid19 new infected (week", 5+1, " in 2020)",sep="")
> JapanPrefMap(col=colors, main=main)
> bk1 <- cls$brks
> text.lg <- paste("[",bk1[-(nclass+1)],",",bk1[-1],")",sep="")
> text.lg[1] <- paste("(",bk1[1],",",bk1[2],")",sep="")
> text.lg <- c("[0]", text.lg)
> leg.plc <- "bottomright"
> legend(leg.plc, legend=text.lg, fill = c("#FFFFFF", rdpu6), cex=1)
Between week 6 to week 12
> for (i in 1:7) {
+ par(mar=c(2,2,2,2))
+ colors <- findc2(counts[i,],cls$brks, rdpu6)
+ colors[which(counts[i,]==0)] <- "#FFFFFF"
+ main <- paste("Covid19 new infected (week", 5+i, " in 2020)",sep="")
+ JapanPrefMap(col=colors, main=main)
+ text.lg <- paste("[",bk1[-(nclass+1)],",",bk1[-1],")",sep="")
+ text.lg[1] <- paste("(",bk1[1],",",bk1[2],")",sep="")
+ text.lg <- c("[0]", text.lg)
+ leg.plc <- "bottomright"
+ legend(leg.plc, legend=text.lg, fill = c("#FFFFFF", rdpu6), cex=1)
+ }
Create animation GIF
saveGIF({
for (i in 1:7) {
par(mar=c(2,2,2,2))
colors <- findc2(counts[i,],cls$brks, rdpu6)
colors[which(counts[i,]==0)] <- "#FFFFFF"
main <- paste("covid19 new infected (week", 5+i, " in 2020)",sep="")
JapanPrefMap(col=colors, main=main)
text.lg <- paste("[",bk1[-(nclass+1)],",",bk1[-1],")",sep="")
text.lg[1] <- paste("(",bk1[1],",",bk1[2],")",sep="")
text.lg <- c("[0]", text.lg)
leg.plc <- "bottomright"
legend(leg.plc, legend=text.lg, fill = c("#FFFFFF", rdpu6), cex=1)
}
})