inst/deploy_scripts/influenza.R

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

library(svamap)
library(sp)
##
data(NUTS_20M)
##
##Read in the point data
########################
pts <- read_point_data("//sva.se/UPP/Temp/Falkenrapporter/AI_vilda.csv")
pts@data$Ankomstdatum <- as.Date(pts@data$Ankomstdatum)
pts <- pts[!is.na(pts@data$Aiv313),]
pts@data$Aiv313[pts@data$Aiv313 == "ej p\u00E5visad, ej p\u00E5visad"] <- "ej p\u00E5visad"
## Make sure the unique values in the Aiv313 vector are what we expect
stopifnot(all(pts@data$Aiv313 %in% c("ej p\u00E5visad", "P\u00C5VISAD")))
stopifnot(all(pts@data$Aivh5313 %in% c(NA, "P\u00C5VISAD", "ej p\u00E5visad")))
stopifnot(all(pts@data$Aivh7313 %in% c(NA, "ej p\u00E5visad")))
pts@data$result <- ifelse(pts@data$Aiv313 == "P\u00C5VISAD", 1,
                   ifelse(pts@data$Aiv313 == "ej p\u00E5visad", 0, 2))
pts@data$result <- as.integer(pts@data$result)
pts <- pts[pts@data$Ankomstdatum > Sys.Date() - 180, ]
##drop duplicates
pts <- pts[!duplicated(pts@data$Namn), ]
## drop those positive on 'Matrix' but are negative for H5 and H7
pts <- pts[!(pts@data$result == 1 & !(pts@data$Aivh5313 == "P\u00C5VISAD" | pts@data$Aivh7313 == "P\u00C5VISAD")),]
pts@data$Namn[pts@data$Namn == ""] <- pts@data[, "Ringm\u00E4rkning"][pts@data$Namn == ""]
##View(pts@data[order(pts@data$Ankomstdatum),])
pts@data <- data.frame(species = pts@data$Djurslag,
                       result = pts@data$result,
                       ViltID = pts@data$Namn,
                       Ankomstdatum = pts@data$Ankomstdatum,
                       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),]
## Only keep those positives that have been approved to be published:
approved <- readLines("ai_approved_to_publish.txt")
## dput(pts@data$ViltID[!(pts@data$ViltID %in% approved) & pts@data$result == 1])
pts <- pts[pts@data$result == 0 | pts@data$ViltID %in% approved, ]
pts@data <- subset(pts@data, select = -c(ViltID))
pts@data$location <- as.numeric(as.factor(paste0(coordinates(pts)[, 1], coordinates(pts)[, 2])))
## Deal with points that land in exactly the same position, deal with
## overlapping points separately in the positives and negatives. This
## is done so that the positives and negatives are always plotted
## separately and that the positives are always plotting on top of the
## negatives.
pos <- pts[pts$result == 1,]
neg <- pts[pts$result == 0,]
neg_un <- do.call("rbind", lapply(unique(neg@data$location), function(x){
    neg[neg@data$location == x,][1,]
}))
if(!is.null(neg_un)){
    for(i in neg_un@data$location){
        temp <- as.data.frame(table(neg[neg@data$location == i,]$Ankomstdatum,
                                    neg[neg@data$location == i,]$species)
                              )
        names(temp) <- c("Datum", "Art", "Antal")
        temp <- temp[temp$Antal != 0,]
        neg_un@data$popup_text[neg_un@data$location == i] <- paste0(html_table(temp, fragment = TRUE, file = NULL), collapse = "\n")
        neg_un@data$n[neg_un@data$location == i] <- sum(temp$Antal)
    }
}
pos_un <- do.call("rbind", lapply(unique(pos@data$location), function(x){
    pos[pos@data$location == x,][1,]
}))
if(!is.null(pos_un)){
    for(i in pos_un@data$location){
        temp <- as.data.frame(table(pos[pos@data$location == i,]$Ankomstdatum,
                                    pos[pos@data$location == i,]$species)
                              )
        names(temp) <- c("Datum", "Art", "Antal")
        temp <- temp[temp$Antal != 0,]
        pos_un@data$popup_text[pos_un@data$location == i] <- paste0(html_table(temp, fragment = TRUE, file = NULL), collapse = "\n")
        pos_un@data$n[pos_un@data$location == i] <- sum(temp$Antal)
    }
}
##Order the positive second so they get plotted last
if(!is.null(neg_un) & !is.null(pos_un)){
    pts <- rbind(neg_un, pos_un)
}
if(!is.null(neg_un) & is.null(pos_un)){
    pts <- neg_un
}
if(is.null(neg_un) & !is.null(pos_un)){
    pts <- pos_un
}
##Calculate the radius of the point
pts@data$radius <- round((pts@data$n*50/3.1415)^0.5, 1)
pts@data <- subset(pts@data, select = c(result, popup_text, radius, Ankomstdatum))
##Write data to geojson
########################
path_to_data <- write_data(pts)

########################
##Deploy map to internal server
########################
write_page(data = path_to_data,
                   path = "//webutv/ESS/AI/",
                   template = "influenza/map.html",
                   overwrite = TRUE,
                   browse = FALSE)
file.copy("//sva.se/UPP/Temp/Falkenrapporter/AI_vilda.csv",
          "//webutv/ESS/AI/",
          overwrite = TRUE)