Data and methods

Libraries and my function

> library(readr)
> library(readxl)
> library(lubridate)
> library(dplyr)
> library(tidyr)
> library(magrittr)
> library(sp)
> library(scanstatistics)
> library(classInt)
> library(RColorBrewer)
> library(sf)
> library(jpndistrict)
> 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
+ }
> 
> data <- read_excel("data/pref/13Tokyo/4_10_tokyo_municipality_infected.xlsx")
> data <- data[-nrow(data),]
> data <- data[,c(1,6:16,20)]
> colnames(data) <- c("ccode", as.character(ymd("2020-3-31")+0:10), "pop")
> data[nrow(data),]$pop <- 2217/1000 #https://www.vill.hinohara.tokyo.jp/0000000160.html
> data %>% mutate(ccode = substr(ccode,2,7)) -> data
> 
> data.counts <- data[,1:12]
> data.counts.long <- gather(data.counts, key = "date", value = "count", -ccode)
> data.counts.long <- left_join(data.counts.long, data %>% select(ccode, pop), by="ccode")
> #data.counts.long %>% mutate(rate = count/pop/100) -> data.counts.long
> data.counts.long %>% mutate(rate = count/pop) -> data.counts.long

Class Intervals

> nclass <- 6
> rdpu6 <- brewer.pal(nclass,"RdPu")
> cls <- classIntervals(as.numeric(data.counts.long$count), nclass, style = "jenks")
> cls.rate <- classIntervals(as.numeric(data.counts.long$rate), nclass, style = "jenks")
> ip <- 13
> sf_pref <- jpn_pref(ip, district = TRUE) 
> sf_pref <- filter(sf_pref, city_code<13360)

Only 20200331

> leg.plc <- "bottomleft"
> map.data <- data.frame(ccode = as.character(sf_pref$city_code))
> # number
> data.color <- left_join(map.data, data.counts.long %>% filter(date == "2020-03-31")%>% select(ccode,count), by="ccode")
> idxz <- c(which(data.color$count == 0))
> col.this <- findc2(data.color$count, cls$brks, rdpu6)
> col.this[idxz] <- "#FFFFFF"
> text.lg <- paste("(",cls$brks[-(nclass+1)],",",cls$brks[-1],"]",sep="")
> text.lg <- c("[0 or NA]", text.lg)
> sf_pref %>% st_geometry() %>% plot(col = col.this, main=paste("2020-03-31"))
> legend(leg.plc, legend=text.lg, fill = c("#FFFFFF",rdpu6), cex=1)

> # rate
> data.color.rate <- left_join(map.data, data.counts.long %>% filter(date == "2020-03-31")%>% select(ccode,rate), by="ccode")
> #idxz <- c(which(data.color$count == 0))
> col.this.rate <- findc2(data.color.rate$rate, cls.rate$brks, rdpu6)
> col.this.rate[idxz] <- "#FFFFFF"
> text.lg.rate <- paste("(",round(cls.rate$brks[-(nclass+1)],2),", ",round(cls.rate$brks[-1],2),"]",sep="")
> text.lg.rate <- c("[0 or NA]", text.lg.rate)
> sf_pref %>% st_geometry() %>% plot(col = col.this.rate, main=paste("rate 2020-03-31"))
> legend(leg.plc, legend=text.lg.rate, fill = c("#FFFFFF",rdpu6), cex=1)

Animation GIF (From 2020/03/31 to 2020/04/10)

dd <- as.character(ymd("2020-3-31")+0:10)
    saveGIF({
     for(id in 1:11){
  par(mfrow=c(2,1))
  data.color <- left_join(map.data, data.counts.long %>% filter(date == dd[id])%>% select(ccode,count), by="ccode")
  idxz <- c(which(data.color$count == 0))
  col.this <- findc2(data.color$count, cls$brks, rdpu6)
  col.this[idxz] <- "#FFFFFF"
  text.lg <- paste("(",cls$brks[-(nclass+1)],",",cls$brks[-1],"]",sep="")
  text.lg <- c("[0 or NA]", text.lg)
  main <- paste("Number of total infected for covid19 (daily) (", dd[id], ")", sep="")
  sf_pref %>% st_geometry() %>% plot(col = col.this, main=main)
  legend(leg.plc, legend=text.lg, fill = c("#FFFFFF",rdpu6), cex=1)

  
  data.color.rate <- left_join(map.data, data.counts.long %>% filter(date == dd[id])%>% select(ccode,rate), by="ccode")
  #idxz <- c(which(data.color$count == 0))
  col.this.rate <- findc2(data.color.rate$rate, cls.rate$brks, rdpu6)
  col.this.rate[idxz] <- "#FFFFFF"
  text.lg.rate <- paste("(",round(cls.rate$brks[-(nclass+1)],2),", ",round(cls.rate$brks[-1],2),"]",sep="")
  text.lg.rate <- c("[0 or NA]", text.lg.rate)
  main <- paste("Rate of total infected (/1k pop) for covid19 (daily) (", dd[id], ")", sep="")
  sf_pref %>% st_geometry() %>% plot(col = col.this.rate, main=main)
  legend(leg.plc, legend=text.lg.rate, fill = c("#FFFFFF",rdpu6), cex=1)
}

    },movie.name = "20200413.gif", img.name = "Tokyo0331to0410",ani.width = 550,ani.height=800)

References