inst/deploy_scripts/ASF_internal.R

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

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

## Filter only those that are wild:
pts <- pts[pts[, "Djurh\u00E5llning"] == "Vilt (Jakt - fiske - natur)" & !is.na(pts[, "Djurh\u00E5llning"]),]

## Mark points without coordinates
pts$xy <- 1
pts$xy[pts$Gisx==""] <- 0

## Assign random coordinates to missing coord points
loc <- readRDS("//sva.se/UPP/Enheter/ESS/ESS gemensamt/Projekt/Salmonella_katt/data/Locality_NUTS.RDS")

## retreive coordinates and put in original data
pts$Gisx[pts$Gisx==""] <- loc$Y[match(pts$Kundort[pts$Gisx==""], loc$LOCALITY)]+sample(100:500, 1)
pts$Gisy[pts$Gisy==""] <- loc$X[match(pts$Kundort[pts$Gisy==""], loc$LOCALITY)]+sample(100:500, 1)

## 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)

## Define the text to go in the popup for the point data
########################
pts$popup_text <- paste0("Ankomstdatum: ", as.Date(pts$Ankomstdatum),
                         "<br>Djuridentitet: ", pts@data$Djuridentitet,
                         "<br>Provtagningsorsak: ", pts@data$Provtagningsorsak.Namn)

## Drop data that you don't want to display from points
########################
pts@data <- data.frame(result = pts@data$Status..numerisk.,
                       popup_text = pts@data$popup_text,
                       Ankomstdatum = as.Date(pts@data$Ankomstdatum),
                       Djuridentitet = pts@data$Djuridentitet,
                       Provtagningsorsak.Namn = pts@data$Provtagningsorsak.Namn,
                       Coordinates = pts@data$xy, stringsAsFactors = FALSE)

## Read wildboar density
########################
load("//sva.se/UPP/Enheter/ESS/EPIZ/Sjukdomar/CSF ASF/WildboarDensity/2017WildboarDensity.RData")

## Read ADSN data
########################
adns <- read.csv2("//sva.se/UPP/Enheter/ESS/EPIZ/Sjukdomar/CSF ASF/WildboarDensity/Wildboar_ADNS.csv", header=TRUE, encoding = "latin1")

adns <- adns[adns$Country != "03 ITALY",]

adns$Date <- as.Date(adns$Confirmation.date, format = "%d-%m-%Y")

# filter disease
adns <- adns[adns$Disease == "12 African swine fever in wild boar",]

adns <- adns[order(as.Date(adns$Date)),]

# concatenate coordinates
coordinates(adns) <- cbind(adns$Longitude.x.+ adns$Longitude.y./60 +adns$Longitude.z../3600,
                           adns$Latitude.x.+ adns$Latitude.y./60 +adns$Latitude.z../3600)

proj4string(adns)<- CRS(proj_4326)
adns@data <- data.frame(Country = adns@data$Country,
                        Date = adns@data$Date)

## Table for barchart
#######################
pivot_adns <- adns@data
st <- as.Date("2014-01-01")
en <- as.Date(Sys.time())
pivot_adns$month <- factor(format(pivot_adns$Date, "%Y-%m"),
                           levels = format(seq(en, st, by = "-1 month"), "%Y-%m"))
pivot_adns$Country <- substr(as.character(pivot_adns$Country), 4, nchar(as.character(pivot_adns$Country)))
pivot_adns$Country <- tools::toTitleCase(tolower(pivot_adns$Country))
pivot_adns <- as.data.frame.matrix(table(pivot_adns$month, pivot_adns$Country))
pivot_adns$date <- rownames(pivot_adns)

## Can be removed when we add sorting in js
pivot_adns <- pivot_adns[order(pivot_adns$date),]

coordinates(pivot_adns) <- cbind(rep(0, nrow(pivot_adns)), rep(0, nrow(pivot_adns)))

##
## PPN for internal use
#######################
ppn <- read.csv2("//sva.se/UPP/Enheter/ESS/EPIZ/Sjukdomar/CSF ASF/PigFarm/PPN - Utdrag med intressent.csv", 
                 sep=",", header=T, stringsAsFactors = FALSE,
                 dec=",", encoding = "UTF-8")

ppn <- ppn[ppn$Platsstatus == "G\u00E4llande", ]
ppn <- ppn[ppn$Djurslag.Typ == "GRIS", ]

ppn <- do.call("rbind", lapply(unique(ppn$Ppn), function(x){
  ppn1 <- ppn[ppn$Ppn == x, c("Ppn", "Produktionsinriktning.Typ")]
  names(ppn1) <- c("PPN", "typ")
  ppn1 <- ppn1[!duplicated(ppn1), ]
  paste(ppn1$typ, collapse = ", ")
  popup_text <- paste0("PPN: ", ppn1$PPN,
                       "<br>Typ: ", paste(ppn1$typ, collapse = ", "))
  data.frame(Ppn = x,
             X = as.numeric(ppn[ppn$Ppn == x, ][1, "X"]),
             Y = as.numeric(ppn[ppn$Ppn == x, ][1, "Y"]),
             popup_text = popup_text,
             stringsAsFactors = FALSE)
}))
## Invert the labels on X and Y
names(ppn)[names(ppn) == "X"] <- "Y1"
names(ppn)[names(ppn) == "Y"] <- "X"
names(ppn)[names(ppn) == "Y1"] <- "Y"
## split the data into those that have coords and those that don't
ppn1 <- ppn[!is.na(ppn$X),]
ppn2 <- ppn[is.na(ppn$X),]

## Get a list of farms to plot
## Convert the data to a spatial object for plotting
sp_ppn <- SpatialPointsDataFrame(cbind(ppn1$X, ppn1$Y), ppn1)

## Define the projection (RT90)
proj4string(sp_ppn) <- "+init=epsg:3006"
## Convert the projected data to Lat/Long (WGS84)
sp_ppn <- spTransform(sp_ppn, "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
## Assign size to dots
sp_ppn@data$radius <- 3.5
## Assign results to dots
sp_ppn@data$result <- 0
sp_ppn@data <- sp_ppn@data[,c("radius", "popup_text")]

##Write data to geojson
########################
path_to_data <- write_data(list(pts, Wildboar_density, adns, pivot_adns, sp_ppn))

##
##Deploy map to internal server
########################
write_page(data = path_to_data,
                   path = "//webutv/ESS/ASF/",
                   template = "ASF_internal/map.html",
                   overwrite = TRUE,
                   browse = FALSE)