inst/deploy_scripts/CWD_timeslider.R

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

library(svamap)
library(sp)
library(CWDsurveillance)
##
data(NUTS_20M)
##
##Read in the point data
########################
pts <- read.csv2("//sva.se/UPP/Temp/Falkenrapporter/E16-036 Grundrapport.csv", encoding="UTF-8", stringsAsFactors = FALSE)

## Manually edit the current case:
## index <- pts$Uppdragid == "U200916-0398"
## pts[index, "Gisx"] <- 7137365
## pts[index, "Gisy"] <- 1734001
## pts$Publicera[index] <- "Ja"
## pts$Status..numerisk.[index] <- 1
## pts[index, "Djurh\u00E5llning"] <- "Vilt (Jakt - fiske - natur)"

## Drop those without coords
pts <- pts[!(pts$Gisx=="") & !(pts$Gisy==""),]

## Convert pts to S4
coordinates(pts) <- cbind(as.numeric(pts$Gisy), as.numeric(pts$Gisx))

proj_3021 = "+proj=tmerc +lat_0=0 +lon_0=15.80827777777778 +k=1 +x_0=1500000 +y_0=0 +ellps=bessel +units=m +no_defs"
proj_4326 = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"

proj4string(pts)<- CRS(proj_3021)
pts <- spTransform(pts, CRSobj = proj_4326)

## Drop any that are not in Sweden:
data("PSU", package = "CWDsurveillance")
PSU <- spTransform(PSU, CRSobj = proj4string(pts))
pts <- pts[!is.na(over(pts, PSU)$PSU),]
########################################################
## REMOVE ALL POSITIVES if Publicera flagg isn't "Ja"###
########################################################
##
## Keep only values "Ja" and "Nej"
pts@data$Publicera <- factor(pts@data$Publicera, levels = c("Ja", "Nej"))
##Now keep all negatives unless Publicera is "Nej"; Drop all Positives unless Publicera is "Ja"
##
pts <- pts[(pts@data$Status..numerisk. == 0 &
            (pts@data$Publicera != "Nej" | is.na(pts@data$Publicera))
           ) |
           (pts@data$Publicera == "Ja" & !is.na(pts@data$Publicera)),]
##pts <- read_point_data()
##
## Drop the points that are not "Vilt (Jakt - fiske - natur)"
########################
selection <-
  as.logical(pts[, "Djurh\u00E5llning"]@data == "Vilt (Jakt - fiske - natur)" &
               !is.na(pts[, "Djurh\u00E5llning"]@data))
pts <- pts[selection,]
##
## Drop if Djurslag is missing
##
pts <- pts[!is.na(pts$Djurslag),]
##
##
## Define the text to go in the popup for the point data
########################
pts$popup_text <- paste0(pts$Djurslag,
                         "<br>Ankomstdatum: ", as.Date(pts$Ankomstdatum),
                         "<br>Djuridentitet: ", pts@data$Djuridentitet)
## Translate the species
############################
species_sw <- c("R\u00E5djur", "\u00C4lg", "Kronhjort", "Ren", "Dovhjort", "\u00C4lg (Sl\u00E4kte)")
species_en <- c("Roe deer", "Moose", "Red deer", "Reindeer", "Fallow deer", "Moose")
pts@data$species_en <- species_en[match(pts@data$Djurslag, species_sw)]

## Add NUTS ID
############################
data("rough_lan", package = "svamap")
data("lan", package = "svamap")

pts@proj4string <- rough_lan@proj4string

pts$NUTS_ID <- over(pts, rough_lan)$NUTS_ID

## Drop data that you don't want to display from points
########################
pts@data <- data.frame(species = pts@data$Djurslag,
                       species_en = pts@data$species_en,
                       result = pts@data$Status..numerisk.,
                       ## popup_text = pts@data$popup_text,
                       Ankomstdatum = as.Date(pts@data$Ankomstdatum),
                       id = as.character(pts@data$Djuridentitet),
                       NUTS_ID = pts@data$NUTS_ID,
                       stringsAsFactors = FALSE)
##
moose <- pts[pts@data$species %in% c("\u00C4lg", "\u00C4lg (Sl\u00E4kte)"),]
deer <- pts[pts@data$species == "R\u00E5djur",]
kronhjort <- pts[pts@data$species == "Kronhjort",]
dovhjort <- pts[pts@data$species == "Dovhjort",]

##Write data to geojson
########################
path_to_data <- write_data(list(pts, moose, deer, kronhjort, dovhjort))

##
## Data to umbraco format
path_to_data_umbraco <- write_data_umbraco(list(pts, moose, deer, kronhjort, dovhjort),
                                           ID = 2577,
                                           startdate = as.Date("2017-11-01"),
                                           apikey = "UMBRACO_KEY")
## Deploy to umbraco
publish_umbraco(
  path_to_data_umbraco,
  live = FALSE)

## And to live umbraco
path_to_data_umbraco <- write_data_umbraco(list(pts, moose, deer, kronhjort, dovhjort),
                                           ID = 4877,
                                           startdate = as.Date("2017-11-01"),
                                           apikey = "UMBRACO_KEY")

## Deploy to umbraco live
(response <- publish_umbraco(
  path_to_data_umbraco,
  live = TRUE))
##
##Deploy map to internal server
########################
write_page(data = path_to_data,
                   path = "//webutv/ESS/CWD_timeslider/",
                   template = "CWD_timeslider/map.html",
                   overwrite = TRUE,
                   browse = FALSE)
## Swap language in the map and send another html
maplines <- readLines(system.file("CWD_timeslider/map.html", package = "svamap"))
swedish_index <- grep("      \\.language_swedish \\{\\}", maplines)
english_index <- grep("      \\.language_english \\{display: none;\\}", maplines)
maplines[swedish_index] <- "      .language_swedish {display: none;}"
maplines[english_index] <- "      .language_english {}"
map_en <- tempfile(fileext = ".html")
writeLines(maplines, con = map_en)
##
## Deploy map

path <- "deploy_pages/cwd_timeslider"
dir.create(file.path(path, "map"), recursive = TRUE, showWarnings = FALSE)

write_page(data = path_to_data,
                   path = file.path(path),
                   template = "CWD_timeslider/map.html",
                   overwrite = TRUE,
                   browse = FALSE)
## Send the modified map file to the same place
file.copy(map_en, file.path(path, "map", "map_en.html"), overwrite = TRUE)