inst/deploy_scripts/CWD_table_with_details.R

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

library(svamap)
library(rgeos)
library(sp)
##
data(rough_lan)
##
##Read in the data
########################
pts <- read.csv2("//sva.se/UPP/Temp/Falkenrapporter/E16-036 Grundrapport.csv")
## This is the data that should be tablulated
pts <- read_point_data("//sva.se/UPP/Temp/Falkenrapporter/E16-036 Grundrapport.csv")
##
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)),]
## 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,]
##
########################
##
##Count points per polygon and species
########################
pts <- pts[!is.na(pts@data$Djurslag),]

pts@proj4string <- rough_lan@proj4string

unique_species <- unique(pts@data$Djurslag)
species_lists <- lapply(unique_species, function(x){
    polys <- match_to_county(pts[pts@data$Djurslag == x,],
                            rough_lan,
                            "NUTS_ID")
    polys <- polys[[1]]
    ## Just keep the basic info for the table
    df <- polys@data[,c("name", "count")]
    df$count <- as.integer(df$count)
    df$count[is.na(df$count)] <- 0
    df$djurslag <- x
    return(df)
})
polys <- match_to_county(pts, rough_lan, "NUTS_ID")
polys <- polys[[1]]
## Just keep the basic info for the table
df <- polys@data[,c("name", "count")]
df$count <- as.integer(df$count)
df$count[is.na(df$count)] <- 0
for(i in seq_len(length(species_lists))) {
    df[,unique(pts@data$Djurslag)[i]] <- species_lists[[i]]$count
}
total <- unlist(lapply(c("count", unique(pts@data$Djurslag)), function(x){
    sum(df[,x])
}))
df <- rbind(df, c("Total", total))
## write the table
nolink <- c("<META NAME='ROBOTS' CONTENT='NOINDEX, NOFOLLOW'>")
tab <- html_table(df,
                  align = c("l", "r", rep("r", length(unique(pts@data$Djurslag)))),
                  col.names = c("L\u00E4n", "Antal unders\u00F6kta", unique(pts@data$Djurslag)),
                  html_head = generate_header(ordering =TRUE, otherstuff = nolink),
                  footer = TRUE
                  )
## Deploy table

path <- "deploy_pages/cwd_table_with_details"
dir.create(path, showWarnings = FALSE)

file.copy(tab, file.path(path, "table.html"), overwrite = TRUE)