Covid_Exposure_ACT.rmd

---
title: "Covid19 exposure locations in the ACT"
resource_files:
- data/last.csv
#runtime: shiny
output:
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
params:
    lup: "unknown"
---

<style>
.crosstalk-input-checkboxgroup{
  color: blue;
  font-size: 12px;
}
</style>

```{r setup, include=TRUE}
library(tidyverse)
library(ggmap)
library(leaflet)
library(plotly)
library(flexdashboard)
library(DT)
library(rgdal)
library(crosstalk)
library(lubridate)
#latest dataset
tab3 <- read.csv("data/last.csv")
# Aggregate method

cols <- c( "red", "yellow","blue")

addBuses <- TRUE

tab3$Contact <- factor(tab3$Contact,levels=c(  "Close"  , "Casual", "Monitor") )
cc <- as.numeric( tab3$Contact)
ncols <- c("black","cyan")
nn <- as.numeric(factor(tab3$Status))
nn2 <- ifelse(nn==1,nn, 3)



tab3$Date <- substr(tab3$Date,1,10) #ditch day of the week
tab3$Date <- as.Date(tab3$Date, format = "%d/%m/%Y")
labs <- paste(tab3$Contact, tab3$Status,tab3$Exposure.Location, tab3$Street, tab3$Suburb, tab3$Date,tab3$Arrival.Time, tab3$Departure.Time, tab3$doubles, sep="<br/>") 

###############################################
##plot the map
df_shared <- crosstalk::SharedData$new(tab3[,c(1,8,2:7)])


m <- leaflet(df_shared) %>% addTiles()


if (addBuses) {
#read from shape file
busses <- readOGR(dsn = "c:/bernd/r/covid_canberra/bus", layer = "geo_export_69c76e06-1d3f-4619-be3b-b4e5789be8ca", verbose = FALSE )

#search all bus lines that are mentioned

bindex <- grep("Bus Route", tab3$Exposure.Location)
buslanes <- tab3$Exposure.Location[bindex]

busnumbers <- gsub("Bus Route ([0-9,A-Z]+) Transport.*","\\1", buslanes)
blineindex <- which(busses$short_name %in% busnumbers)
blabs <- paste(paste0("Bus route: ", busses$short_name[blineindex]),"<strong> For bus stops and ","exposure times, please"," search the table." , sep="<br/>")
bb <- (busses[blineindex,])
coo <- coordinates(bb)
bcols <- colorRampPalette(c("purple", "green"))( length(coo))
if (length(coo)>0)
{
for (ib in 1:length(coo))
{
  cood <- data.frame(coo[[ib]])
  m <- m %>% addPolylines(lng=cood[,1], lat=cood[,2], color = bcols[ib], weight   = 3, opacity = 0.4, popup  = blabs[ib])
}
}
}


m <- m %>% addCircleMarkers(lat=tab3$lat, lng=tab3$lon,popup = labs, weight=nn2, fillColor = cols[cc],color=ncols[nn], opacity =0.8, radius = 5 , fillOpacity = 0.8)
  #                           , clusterOptions =markerClusterOptions(spiderfyDistanceMultiplier=1.5,
  # iconCreateFunction=JS("function (cluster) {    
  # 
  #   var childCount = cluster.getChildCount();  
  # 
  #   if (childCount < 100) {  
  #     c = 'rgba(64, 64, 64, 0.5);'
  #   } else if (childCount < 1000) {  
  #     c = 'rgba(64, 64, 64, 0.5);'  
  #   } else { 
  #     c = 'rgba(64, 64, 64, 0.5);'  
  #   }    
  #    return new L.DivIcon({ html: '<div style=\"background-color:'+c+'\"><span>' + childCount + '</span></div>', className: 'marker-cluster', iconSize: new L.Point(40, 40) });
  # }"))                                                                                                                           #) 
m <- m %>%  addLegend("bottomright", labels = levels(tab3$Contact), colors = cols, opacity = 0.8)

####################################################
### add bus lines mentioned




```

```{r title, results='asis'} 

cat(paste0("# ", params$lup))


```
<sup>Disclaimer: This map shows the covid exposure locations in the ACT and is an **unofficial website** based on [official sources](https://www.covid19.act.gov.au/act-status-and-response/act-covid-19-exposure-locations). So if in doubt, refer to the [offical website](https://www.covid19.act.gov.au/act-status-and-response/act-covid-19-exposure-locations), which has now also an [**official map**](https://www.covid19.act.gov.au/act-status-and-response/act-covid-19-exposure-locations/map#Map-of-ACT-exposure-locations) included. Supported by Volunteers from the University of Canberra. Contacts: Bernd Gruber [bernd.gruber@canberra.edu.au] & Anthony Davidson [anthony.davidson@canberra.edu.au]</sup>



Column {data-width=500}
------------------------------------------------------------
### Map of Exposure sites and exposed bus routes

```{r}
m
```

Column {data-width=400}
------------------------------------------------------------
### Table of Exposure sites

```{r}
# bscols(
#   filter_checkbox(
#     id = "contact",
#     label = "",
#     sharedData = df_shared,
#     group = ~Contact,
#     inline=TRUE
#   ))
#bscols(  filter_select(id="dates", label="Date",sharedData = df_shared, group=~Date))

dtt <-DT::datatable(df_shared,
     caption = 'Search for entries, (shift)click to select, this highlights the locations in the map.',selection = "multiple", rownames = FALSE, 
  extensions = c("Buttons", "Select", "Responsive"), options = list(autoHideNavigation=FALSE, pageLength=50,
   dom = 'Bfrtip',
            select = TRUE, 
            buttons = list(
              "copy",
              list(
                extend = "selectNone",
                text = "Clear"
              )
            ),                                   
  initComplete = JS(
        "function(settings, json) {",
        "$(this.api().table().header()).css({'font-size': '50%'});",

        "}")))  %>% DT::formatStyle(columns = 1:8, fontSize='70%') 

dtt

```

Column {data-width=100}
------------------------------------------------------------

### Filter
```{r}

bscols(
  filter_checkbox(
    id = "contact",
    label = "Contact",
    sharedData = df_shared,
    group = ~Contact,
    columns = 1
  ))

bscols(
  filter_checkbox(
    id = "status",
    label = "Status",
    sharedData = df_shared,
    group = ~Status,
    columns = 1
  ))

bscols(  filter_select(id="dates", label="Date",sharedData = df_shared, group=~Date))
bscols(  filter_select(id="suburb", label="Suburb",sharedData = df_shared, group=~Suburb))

```