A Shiny web application for plotting rainforest tree species on a map with googleVis and rgbif::gbifmap. Data by Rainforest Foundation Norway and Global Biodiversity Information Facility

global.R

############################################################################################
#
# 12.1.2014 Tuija Sonkkila
#
# Shiny web application for plotting rainforest tree species on a map
# with googleVis and rgbif::gbifmap
#
# Data by Rainforest Foundation Norway and Global Biodiversity Information Facility
# 
# http://www.regnskog.no/no/bevisst-forbruker/tropisk-t%C3%B8mmer/oversikt-tropiske-treslag
# http://www.gbif.org/
#
# Rainforest Foundation Norway data scraped by Scraper
#
# GBIF API query with the rgbif wrapper by rOpenSci
#
###########################################################################################

library(shiny)
library(ggplot2)
library(RColorBrewer)
library(rgbif)
library(googleVis)
library(RCurl)


# Scraped with Scraper from http://en.wikipedia.org/wiki/ISO_3166-1_alpha-2
countrydata <- getURL("https://docs.google.com/spreadsheets/d/1GS1MrfozPCvQ1VLBZMBt_wlHtD1M7_paA1stDrr_rd4/pub?output=csv",
                      .encoding="UTF-8",
                      ssl.verifypeer = FALSE)
cdata <- read.csv(text = countrydata)

# Columns to continue with
cols <- c("name","longitude", "latitude", "country")

if(file.exists("Extinct.Rda")){
  load("Extinct.Rda")
  Extinct <- Extinct[ ,cols]
  Extinct <- merge(Extinct, cdata, by.x="country", by.y="Acronym")
}
if(file.exists("Critically_Endangered.Rda")){
  load("Critically_Endangered.Rda")
  Critically_Endangered <- Critically_Endangered[ ,cols]
  Critically_Endangered <- merge(Critically_Endangered, cdata, by.x="country", by.y="Acronym")
}
if(file.exists("Endangered.Rda")){
  load("Endangered.Rda")
  Endangered <- Endangered[ ,cols]
  Endangered <- merge(Endangered, cdata, by.x="country", by.y="Acronym")
}
if(file.exists("Vulnerable.Rda")){
  load("Vulnerable.Rda")
  Vulnerable <- Vulnerable[ ,cols]
  Vulnerable <- merge(Vulnerable, cdata, by.x="country", by.y="Acronym")
}
if(file.exists("Near_Threatened.Rda")){
  load("Near_Threatened.Rda")
  Near_Threatened <- Near_Threatened[ ,cols]
  Near_Threatened <- merge(Near_Threatened, cdata, by.x="country", by.y="Acronym")
}
if(file.exists("Other.Rda")){
  load("Other.Rda")
  Other <- Other[ ,cols]
  Other <- merge(Other, cdata, by.x="country", by.y="Acronym")
}


statuses <- character()
for(i in c("Extinct", "Critically_Endangered", "Endangered", "Vulnerable", "Near_Threatened", "Other")) {
  if(exists(i)) {
    statuses <- c(statuses, i)
  }
}

mygbifmap.R

############################################
#
# 12.1.2014 Tuija Sonkkila
#
# The function modifies rgbif::gbifmap
# by adding an alpha argument
#
# rgbif by rOpenSci
#
###########################################

mygbifmap <- function(input = NULL, mapdatabase = "world", region = ".", 
                      geom = geom_point, jitter = NULL, alpha = 0.4, customize = NULL)
{
  long = NULL
  lat = NULL
  group = NULL
  longitude = NULL
  latitude = NULL
  name = NULL
  
  #   if(!is.gbiflist(input))
  #     stop("Input is not of class gbiflist")
  
  tomap <- input[complete.cases(input$latitude, input$latitude), ]
  tomap <- tomap[!tomap$longitude==0 & !tomap$latitude==0,]
  tomap <- input[-(which(tomap$latitude <=90 || tomap$longitude <=180)), ]
  tomap$name <- as.factor(gbif_capwords(tomap$name, onlyfirst=TRUE))
  
  if(length(unique(tomap$name))==1){ theme2 <- theme(legend.position="none") } else 
  { theme2 <- NULL }
  
  world <- map_data(map=mapdatabase, region=region)
  message(paste("Rendering map...plotting ", nrow(tomap), " points", sep=""))
  
  ggplot(world, aes(long, lat)) +
    geom_polygon(aes(group=group), fill="white", color="gray40", size=0.2) +
    geom(data=tomap, aes(longitude, latitude, colour=name), 
         alpha=alpha, size=3, position=jitter) +
    scale_color_brewer("", type="qual", palette=6) +
    labs(x="", y="") +
    theme_bw(base_size=14) +
    theme(legend.position = "bottom", legend.key = element_blank()) +
    guides(col = guide_legend(nrow=2)) +
    blanktheme() +
    theme2 + 
    customize
}

server.R

############################################################################################
#
# 12.1.2014 Tuija Sonkkila
#
# Shiny web application for plotting rainforest tree species on a map
# with googleVis and rgbif::gbifmap
#
# Data by Rainforest Foundation Norway and Global Biodiversity Information Facility
# 
# http://www.regnskog.no/no/bevisst-forbruker/tropisk-t%C3%B8mmer/oversikt-tropiske-treslag
# http://www.gbif.org/
#
# Rainforest Foundation Norway data scraped by Scraper
#
# GBIF API query with the rgbif wrapper by rOpenSci
#
###########################################################################################


shinyServer(function(input, output) {
  
  
  rdata <- reactive({
    
    if (is.null(input$c))
      return(NULL)
    if (exists(input$c))
      get(input$c)
  })
  
  output$gvis <- renderGvis({
    
    myData <- rdata()
    
    # gVis needs a lat:lon column
    myData$Loc <- paste(myData$latitude, myData$longitude, sep=":")
    # A number showing how many occurrences there are of this species on this location
    # Used in deciding the size of the markers
    # http://stackoverflow.com/questions/7450600/how-do-i-count-aggregate-values-from-a-data-frame-and-reincorporate-them-into-th
    myData$Count <- ave(myData$Loc, myData[ ,"Loc"], FUN=length)
    # Pasting country name to tooltip
    myData$Text <- paste(myData$name, " (", myData$Name, ")", sep = "")
    gvisGeoChart(myData,
                 locationvar="Loc", 
                 sizevar="Count",
                 hovervar="Text",
                 options=list(displayMode="Markers", 
                              colorAxis="{colors: ['#e7711c', '#4374e0']}",
                              markerOpacity=0.6,
                              height=600)
    )
    
    
  })
  
  
  output$gbifmap <- renderPlot({
    
    if (is.null(rdata()))
      return(NULL)
    
    library(RColorBrewer)

    # http://novyden.blogspot.fi/2013/09/how-to-expand-color-palette-with-ggplot.html
    colourCount = length(unique(rdata()$name))
    getPalette = colorRampPalette(brewer.pal(9, "Set1"))

    source("mygbifmap.R")
    
    p <- mygbifmap(rdata(), 
                   alpha = 0.8,
                   customize = list(scale_colour_manual(values = getPalette(colourCount)),
                                    guides(col = guide_legend(ncol=4)))) 
    
    print(p)
    
  })
  
  
  output$data <- renderTable({
    
    if (is.null(rdata()))
      return(NULL)
    rdata()
    
  }, include.rownames = FALSE)
  
})

ui.R

############################################################################################
#
# 12.1.2014 Tuija Sonkkila
#
# Shiny web application for plotting rainforest tree species on a map
# with googleVis and rgbif::gbifmap
#
# Data by Rainforest Foundation Norway and Global Biodiversity Information Facility
# 
# http://www.regnskog.no/no/bevisst-forbruker/tropisk-t%C3%B8mmer/oversikt-tropiske-treslag
# http://www.gbif.org/
#
# Rainforest Foundation Norway data scraped by Scraper
#
# GBIF API query with the rgbif wrapper by rOpenSci
#
###########################################################################################

shinyUI(pageWithSidebar(
  
  headerPanel("Red-listed rainforest tree species"),
  
  
  sidebarPanel(
    
    selectInput(inputId = "c", 
                label = "Choose status:",
                choices = statuses,
                selected = c("Endangered"))  
  ),
  
  
  mainPanel(
    tabsetPanel(
      tabPanel("Map", htmlOutput("gvis"),
               br(), br(),
               a(href = "http://www.regnskog.no/no/bevisst-forbruker/tropisk-t%C3%B8mmer/oversikt-tropiske-treslag", target = "_blank", "Species by Rainforest Foundation Norway"),
               br(),
               a(href = "http://www.gbif.org/", target = "_blank", "Location data by Global Biodiversity Information Facility (GBIF)"),
               br(), br(),
               a(href = "http://tts2.blogspot.fi/2014/01/mapping-red-listed-rainforest-tree.html", target = "_blank", "See blog post")),
      tabPanel("Static map", plotOutput("gbifmap", height = "700px", width = "auto")),
      tabPanel("Data", tableOutput("data"))
    )
  )
))