inst/deploy_scripts/influenza_timeseries.R

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

library(svamap)
library(sp)
library(RCurl)
##
data(NUTS_20M)
##
##Read in the point data
########################
pts <- read.csv2("//sva.se/UPP/Temp/Falkenrapporter/AI_vilda.csv", stringsAsFactors = FALSE, encoding = "UTF-8")
pts$Ankomstdatum <- as.Date(pts$Ankomstdatum)
pts$Aiv313[pts$Aiv313 == ""] <- NA
pts <- pts[!is.na(pts$Aiv313), ]
pts$Aiv313[pts$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$Aiv313 %in% c("ej p\u00E5visad", "P\u00C5VISAD")))
stopifnot(all(pts$Aivh5313 %in% c("", "P\u00C5VISAD", "ej p\u00E5visad")))
stopifnot(all(pts$Aivh7313 %in% c("", "ej p\u00E5visad")))
pts$result <- ifelse(pts$Aiv313 == "P\u00C5VISAD", 1,
                   ifelse(pts$Aiv313 == "ej p\u00E5visad", 0, 2))
pts$result <- as.integer(pts$result)
pts <- pts[pts$Ankomstdatum > "2016/01/01 00:00:00", ]
##drop duplicates
pts <- pts[!duplicated(pts$Namn), ]
## drop those positive on 'Matrix' but are negative for H5 and H7
pts <- pts[!(pts$result == 1 & !(pts$Aivh5313 == "P\u00C5VISAD" | pts$Aivh7313 == "P\u00C5VISAD")),]
pts$Namn[pts$Namn == ""] <- pts[, "Ringm\u00E4rkning"][pts$Namn == ""]
##View(pts@data[order(pts@data$Ankomstdatum),])
pts <- data.frame(species = pts$Djurslag,
                  status = pts$result,
                  ViltID = pts$Namn,
                  date = pts$Ankomstdatum,
                  stringsAsFactors = FALSE)
## Drop if the sample is not yet complete:
pts <- pts[pts$status != 2,]
## 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$status == 0 | pts$ViltID %in% approved, ]
df <- time_count(pts$date[pts$status == 1],
           "months",
           "freq",
           tmin = min(pts$date, na.rm = TRUE),
           tmax = max(pts$date, na.rm = TRUE))
names(df)[names(df) == "n"] <- "pos"
df$neg <- time_count(pts$date[pts$status == 0],
           "months",
           "freq",
           tmin = min(pts$date, na.rm = TRUE),
           tmax = max(pts$date, na.rm = TRUE))$n

df$months <-
  paste0(months(as.POSIXlt(as.Date(df$months)), abbreviate = FALSE),
         "-" ,
         as.POSIXlt(as.Date(df$months))$year + 1900)

## Write to web
data <- tempfile()
graph <- tempfile()
my_y_axis <- yAxes(list(yAxis("a", "linear", "left", NULL, NULL, display = TRUE, labelString = "Antal f\u00E5glar per m\u00E5nad")))
write_UTF8(timeseries_html("data", "ai_data.js", yAxes = my_y_axis), graph)
write_UTF8(timeseries_json(df = df,
                           dataname = "data",
                           x = "months",
                           series_label = c("P\u00E5visad",
                                            "Ej p\u00E5visad"),
                           type = c("bar", "bar"),
                           backgroundColor = c("#D22630", "#00A9CE"),
                           hoverBackgroundColor = c("#B90D17", "#00769B"),
                           fill = c(FALSE),
                           hidden = c(FALSE, FALSE),
                           pointRadius = 0,
                           yAxisID = c("a", "a")), data)
file.copy(graph, "//webutv/ESS/AI/ai_timeseries.html", overwrite = TRUE)
file.copy(data, "//webutv/ESS/AI/ai_data.js", overwrite = TRUE)