inst/deploy_scripts/tularemia_map.R

In SVA-SE/svamap: Package to produce data summaries for the web

#####################################################################################
library(svamap)
library(sp)
library(readxl)
library(rjson)
data(NUTS_20M)
####################################
## Read in the rapportera vilt data:
####################################
rap_vilt <- fromJSON(file = "https://rapporteravilt.sva.se/api/OpenApi/GetFynd")[[1]]
rap_vilt <- do.call("rbind", lapply(rap_vilt, function(x){
  x <- lapply(x, function(y){
    ifelse(is.null(y), NA, y)
  })
  as.data.frame(x)
}))
## Throw away observations with nonconforming xy locations this weeds
## out those that will cause the projection to not work
rap_vilt <- rap_vilt[rap_vilt$Lat > 53 & rap_vilt$Lat < 69,]
rap_vilt <- rap_vilt[rap_vilt$Long > 10 & rap_vilt$Long < 25,]

## Convert to spatial
rap_vilt <- SpatialPointsDataFrame(cbind(rap_vilt$Long, rap_vilt$Lat), rap_vilt)
proj4string(rap_vilt) <- "+init=epsg:4326"
rap_vilt@data$popup_text <- paste0("<b>Djur rapporterade till <a target='_blank' href='https://rapporteravilt.sva.se/'> rapporteravilt.sva.se</a></b><br>",
                                   "Djurslag: ", rap_vilt@data$Species, "<br>",
                                   "Antal djur: ", rap_vilt@data$NumberOfFinds, "<br>",
                                   "Skick: ", rap_vilt@data$State, "<br>",
                                   "Rapportdatum: ", rap_vilt@data$Created)

rap_vilt@data <- rap_vilt@data <- data.frame(species = rap_vilt@data$Species,
                                             date = as.Date(rap_vilt@data$Created),
                                             size = round(((as.numeric(rap_vilt@data$NumberOfFinds)*50/3.1415)^0.5), 0),
                                             popup_text = rap_vilt@data$popup_text,
                                             stringsAsFactors = FALSE)

rap_vilt <- rap_vilt[rap_vilt@data$species %in% c("Skogshare", "F\u00E4lthare", "Hare"),]
rap_vilt@data$layer <- 2
rap_vilt@data$table <- 0
rap_vilt@data$result <- 2
#add NUTS_ID
data("rough_lan", package = "svamap")
rap_vilt <- spTransform(rap_vilt, proj4string(rough_lan))
rap_vilt@data$NUTS_ID <- over(rap_vilt, rough_lan)$NUTS_ID
## Drop if outside Sweden
rap_vilt <- rap_vilt[!is.na(rap_vilt$NUTS_ID),]
########################
##Read in the point data
########################
pts <- read_point_data("//sva.se/UPP/Temp/Falkenrapporter/Harpest-falkenrapport.csv")
pts@data$Ankomstdatum <- as.Date(pts@data$Ankomstdatum)
pts <- pts[pts@data$Ankomstdatum > "2016/01/01 00:00:00", ]
##drop a fox:
pts <- pts[pts@data$Djurslag != "R\u00F6dr\u00E4v",]

## Add popup text
result <- ifelse(pts@data$Status..numerisk. == 1, "P\u00E5visad smitta", "Ej p\u00E5visad smitta")
pts@data$popup_text <- paste0("<b>Provtagits f\u00F6r harpest</b><br>",
                              "Djurslag: ", pts@data$Djurslag, "<br>",
                              "Ankomstdatum: ", pts@data$Ankomstdatum, "<br>",
                              "ID: ", pts@data$Djuridentitet, "<br>",
                              "Resultat: ", result)

pts@data <- data.frame(species = pts@data$Djurslag,
                       result = pts@data$Status..numerisk.,
                       date = pts@data$Ankomstdatum,
                       popup_text = pts@data$popup_text,
                       stringsAsFactors = FALSE)

## Drop if the sample is not yet complete:
pts <- pts[pts$result != 2,]
## sort by påvisade to get the positives plotted last
pts <- pts[order(pts@data$result),]
###################################
## Read the all incoming hares data
###################################
all_hares <- read.csv2("//sva.se/UPP/Temp/Falkenrapporter/alla_harar_inkommande", stringsAsFactors = FALSE, encoding="UTF-8")
all_hares <- all_hares[!all_hares[, "Ins\u00E4ntmaterial.Id"] %in% pts@data$ID, ]
all_hares$Gisx <- as.numeric(all_hares$Gisx)
all_hares$Gisy <- as.numeric(all_hares$Gisy)
all_hares <- all_hares[complete.cases(all_hares[, c("Gisx", "Gisy")]),]
all_hares <- SpatialPointsDataFrame(cbind(all_hares$Gisy, all_hares$Gisx), all_hares)
proj4string(all_hares) <- "+init=epsg:3021"
all_hares <- spTransform(all_hares, proj4string(pts))
all_hares@data$date <- as.Date(all_hares@data$Ankomstdatum)

all_hares@data$popup_text <- paste0("<b>Harar inskickade till SVA d\u00E4r harpest uteslutits med mikroskopisk unders\u00F6kning</b><br>",
                                    "Djurslag: ", all_hares@data$"Djurslag.Kod.Namn", "<br>",
                                    "Ankomstddatum: ", all_hares@data$Ankomstdatum, "<br>",
                                    "ID: ", all_hares$Djurindivid...avancerat.Namn, "<br>",
                                    "Resultat: Ej p\u00E5visad smitta")
all_hares@data <- data.frame(species = all_hares@data$"Djurslag.Kod.Namn",
                             result = 0,
                             date = all_hares@data$date,
                             popup_text = all_hares@data$popup_text,
                             stringsAsFactors = FALSE)
pts <- rbind(all_hares, pts)

proj4string(pts) <- proj4string(rough_lan)

pts@data$layer <- 1
pts@data$table <- 1
pts@data$size <- 4
pts@data$NUTS_ID <- over(pts, rough_lan)$NUTS_ID
data <- rbind(rap_vilt, pts)

## Data to umbraco format
path_to_data_umbraco <- write_data_umbraco(data, ID = 2420, startdate = Sys.Date() - 180, apikey = "UMBRACO_KEY")

## Deploy to umbraco
publish_umbraco(path_to_data_umbraco,
                live = FALSE)

## And to live umbraco
## Data to umbraco format
path_to_data_umbraco <- write_data_umbraco(data, ID = 4894, startdate = Sys.Date() - 180, apikey = "UMBRACO_KEY")
## Deploy to umbraco
(response <- publish_umbraco(path_to_data_umbraco,
                             live = TRUE))