inst/deploy_scripts/Salmonella_cat_timeslider.R

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

library(svamap)
library(sp)
library(binom)   # for binomial condfidence intervals
library(reshape2) # for melt

dt2020 <- read.csv("//sva.se/UPP/Temp/Falkenrapporter/E20-006 Grundrapport.csv", encoding="UTF-8", stringsAsFactors = FALSE)
dt <- read.csv("//sva.se/UPP/Enheter/ESS/ESS gemensamt/Projekt/Salmonella_katt/data/salmonella_cat_2010-2019.csv", encoding = "latin1")
loc <- readRDS("//sva.se/UPP/Enheter/ESS/ESS gemensamt/Projekt/Salmonella_katt/data/Locality_NUTS.RDS")

options(scipen=999) # remove scientific notation
cleandata <- function(df){
  df <- df[df$Djurslag == "Katt",]
  df$year <- strftime(df$Ankomstdatum, "%Y")
  df$date <- format(as.Date(df$Ankomstdatum, format="%Y/%m/%d"),"%Y-%m")
  df$uid <- gsub(",", "", gsub(" ", "", paste(df$Djuridentitet, df[, "Djur\u00E4gare"])))
  df <- do.call("rbind", lapply(unique(df$uid), function(x) {
    y <- df[df$uid == x,]
    y$foo <- 1
    y$foo[y$Status..numerisk == 1] <- 0
    y$comment <- as.numeric(grepl("Det finns", y$Kommentar))
    y <- y[order(y$foo, y$comment, as.Date(y$Ankomstdatum)), ]
    y[1,]
  }))
  return(df)
}

if(length(dt2020[,1])>0) {
  df <- cleandata(dt2020)
  if(length(grep("Det finns", df$Kommentar))>0)
  df <- df[-grep("Det finns", df$Kommentar),]

  # retreive coordinates and put in original data
  df$X <- loc$X[match(df$Kundort, loc$LOCALITY)]
  df$Y <- loc$Y[match(df$Kundort, loc$LOCALITY)]

  # extract to which län each ort belongs to
  df$NUTS3 <- loc$NUTS_3[match(df$Kundort, loc$LOCALITY)]
  df$county <- loc$COUNTY[match(df$Kundort, loc$LOCALITY)]
  Encoding(levels(df$county)) <- "latin1"

  ########################
  # BUILD UNIQUE DATASET #
  ########################
  salmo <- df[,c("Uppdragid","Ankomstdatum", "year",
                 "date", "Status..numerisk.", "Kundort",
                 "X", "Y", "NUTS3", "county")]
  names(salmo)[names(salmo) == "Status..numerisk."] <- "result"

  # dummy coding for test result
  salmo$pos <- ifelse(salmo$result==1, 1, 0)
  salmo$neg <- ifelse(salmo$result==0, 1, 0)
  salmo$ong <- ifelse(salmo$result==2, 1, 0)

  salmo <- rbind(dt, salmo)
}else {
  salmo <- dt
}

##########################
# Aggregate data by time #
##########################
pos <- aggregate(result==1 ~ date, salmo, sum)
neg <- aggregate(result==0 ~ date, salmo, sum)
ong <- aggregate(result==2 ~ date, salmo, sum)

#####################
# SPATIAL DATAFRAME #
#####################

data("rough_lan", package = "svamap")
data("lan", package = "svamap")

salmogeo <- salmo[complete.cases(salmo[,c("X", "Y")]),]
coordinates(salmogeo)<-c("X", "Y")
proj4string(salmogeo) <- CRS("+init=epsg:3021") #"+init=epsg:3021"==proj4string(loc)
salmogeo <- spTransform(salmogeo, CRSobj =proj4string(rough_lan))#"+init=epsg:4326")

salmogeo$NUTS_ID <- over(salmogeo, rough_lan)$NUTS_ID ## add kommun code
salmogeo$NUTS_ID <- as.character(salmogeo$NUTS_ID)
###################
# SAMPLES PER LÄN #
###################
num_per_lan <- aggregate(result ~ NUTS_ID + date , data=salmogeo, FUN=function(x) length(x))
colnames(num_per_lan)[3] <- "samples"
num_per_lan$pos <- aggregate(pos ~ NUTS_ID + date , data=salmogeo, FUN=function(x) sum(x))[["pos"]]
num_per_lan$neg <- aggregate(neg ~ NUTS_ID + date , data=salmogeo, FUN=function(x) sum(x))[["neg"]]
num_per_lan$pos <- as.integer(num_per_lan$pos)
num_per_lan$neg <- as.integer(num_per_lan$neg)
## ADD dummy coordinates
num_per_lan$X <- 0
num_per_lan$Y <- 0
coordinates(num_per_lan)<-c("X", "Y")
proj4string(num_per_lan) <- proj4string(salmogeo)
num_per_lan$table <- 1

##Write data to geojson
########################
path_to_data <- write_data(list(num_per_lan, lan))

## Data to umbraco format
path_to_data_umbraco <- write_data_umbraco(list(num_per_lan, lan), ID = 2421, startdate = Sys.Date() - 180, apikey = "UMBRACO_KEY")

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

## Data to umbraco format (Live)
path_to_data_umbraco <- write_data_umbraco(list(num_per_lan, lan), ID = 4898, startdate = Sys.Date() - 180, apikey = "UMBRACO_KEY")

## Deploy to umbraco (Live)
(response <- publish_umbraco(path_to_data_umbraco,
                             live = TRUE))