-
Notifications
You must be signed in to change notification settings - Fork 0
/
eventUSMap.R
146 lines (127 loc) · 4.72 KB
/
eventUSMap.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
library(dplyr)
library(Hmisc)
library(stringr)
library(ggthemes)
library(data.table)
library(RColorBrewer)
library(leaflet)
library(sf)
dataTracking = fread('https://covid19-lake.s3.us-east-2.amazonaws.com/tableau-covid-datahub/csv/COVID-19-Activity.csv')
county <<- st_read("https://raw.githubusercontent.com/appliedbinf/covid19-event-risk-planner/b96fa86886b1f7b9c62ed2853bd07c7bcdaa7f0a/COVID19-Event-Risk-Planner/map_data/tl_2017_us_county.geojson")
stateline <<- st_read("https://raw.githubusercontent.com/appliedbinf/covid19-event-risk-planner/b96fa86886b1f7b9c62ed2853bd07c7bcdaa7f0a/COVID19-Event-Risk-Planner/map_data/tl_2017_us_state.geojson")
pop <- read.csv("https://raw.githubusercontent.com/appliedbinf/covid19-event-risk-planner/b96fa86886b1f7b9c62ed2853bd07c7bcdaa7f0a/COVID19-Event-Risk-Planner/map_data/county-population.csv", stringsAsFactors = FALSE)
##########################################################
dataTracking <- as.data.frame(dataTracking)
USIndex <- which(dataTracking[,10] == 'United States')
USdataTracking <- dataTracking[USIndex,]
USData <- USdataTracking[,c(2,4,3,8,1)]
# turn all counties into lowercase
USData <- USData%>%
rename(
Positive = names(USData)[5],
date = REPORT_DATE,
County = COUNTY_NAME,
State = PROVINCE_STATE_NAME,
fips = COUNTY_FIPS_NUMBER
)
USData$date<- strptime(as.character(USData$date), "%m/%d/%Y")
USData$date <- format(USData$date, "%Y-%m-%d")
USData$date <- as.Date(USData$date)
USData$County <- tolower(USData$County)
USData$State <- tolower(USData$State)
databyState <- function(state, num){
subData <- USData[which(USData[,"State"] == state),]
subData <- subData[rev(order(subData$date)),]
dateSelected <- subData$date[1] - num
todayData <- subData[which(subData[,'date'] == dateSelected),]
todayData <- todayData[order(todayData$County),]
return(todayData)
}
state_df_today <- databyState(USData$State[1],0)
state_df_past <- databyState(USData$State[1],14)
for (i in 2:length(unique(USData$State))){
state_df_today <- rbind(state_df_today, databyState(unique(USData$State)[i],0))
state_df_past <- rbind(state_df_past, databyState(unique(USData$State)[i],14))
}
state_df_today <- state_df_today[order(state_df_today$State),]
state_df_past <- state_df_past[order(state_df_past$State),]
state_df <- cbind(state_df_today, state_df_past[5])
state_df <- state_df %>%
rename(
Today_Positive = names(state_df)[5],
)
state_df <- state_df %>%
rename(
Past_Positive = names(state_df)[6]
)
df <- inner_join(state_df,pop, by = 'fips')
df$County <- capitalize(df$County)
df$State <- capitalize(df$State)
eventMap <- function(size){
risk <- as.data.frame(round((1-(1-10*(df$Today_Positive-df$Past_Positive)/df$pop)**size)*100,2))
df[,9] <- risk
names(df)[9] <- 'risk'
###############
df <- df[,c("County","State","date","fips","Today_Positive","risk")]
df <- inner_join(county,df, by = c("GEOID" = "fips"))
bins <- c(0,1,25,50,75,99,100)
pal <- colorBin("YlOrRd", domain = df$risk, bins = bins, na.color = 'grey')
labels <- sprintf(
"<strong>County: %s</strong><br/>State: %s<br/>Risk Score: %g%%<br/>Confirmed Cases: %g",
df$County, df$State, df$risk, df$Today_Positive
) %>% lapply(htmltools::HTML)
labels_Missing <-sprintf(
"<strong>County: %s</strong><br/>State: %s<br/>Risk Score: Missing Data",
county$NAME, county$stname
) %>% lapply(htmltools::HTML)
leaflet(df) %>%
setView(-96, 37.8, 4) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addPolygons(
data = county,
fillColor = 'grey',
weight = 0.5,
opacity = 1,
color = "black",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels_Missing,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")
) %>%
addPolygons(
fillColor = ~pal(risk),
weight = 0.5,
opacity = 1,
color = "black",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addPolygons(
data = stateline,
fill = FALSE,
color = 'black',
weight = 1
) %>%
addLegend(pal = pal, values = ~df$risk, opacity = 0.7, title = 'Risk Score (%)',
position = "bottomright")
}
eventMap(100)