global.R

library(shiny)
library(shinyIncubator)
library(rbison)
library(rjson)
library(taxize)
library(plyr)
library(googleVis)
library(XML)
library(stringr)

server.r

#plotHeight=0 works here
shinyServer(function(input, output) {
 # addResourcePath('common', 'C:/Users/pssguy/Documents/R/Examples/Shiny/common')
   
  # dynamic UI setting up the selection dropdown works
  output$selection <- renderUI( {
    
    print("enterSelection")
    print(input$common)
    if (is.null(input$common)) return(NULL)
    if (input$common=="") return(NULL)
    #species <- searchforanymatch("coyote")
    species <- searchforanymatch(input$common)
    print(species)
    #print(species[[1]][1][[1]]) nrow(species)
    #if (is.null(species[[1]][1][[1]])) {
      if (nrow(species)==0) {
      print("is null")
      return(NULL)
    }
#     print(length(species))
#     species <- data.frame(comName=species[1],sciname=species[4]) # sticks to original names
#     print("nrow coming")
#     print(nrow(species))
#     print(str(nrow(species)))
#     if (nrow(species==0)) {
#       print("should return")
#       return(NULL)
#     }
    
#     print("didnt return")
#     speciesList <- ddply(species, "sciname", function(x) c(comName=x$comname[1]))
     speciesSelection <- species$sciname
    names(speciesSelection) <- paste0(species$comname,":  ",species$sciname)
    selectInput("species","Select Species",speciesSelection)
  })
  
  # do calculations
   theData <- reactive( {
     print("enterData")
     print(input$common)
     print(input$species)
  if (is.null(input$species)) return(NULL)
#   if (input$common=="") return(NULL)
     print(input$species)
     df.init <- bison(species = input$species, type = "scientific_name", start = 0, count = 20) # big numbers cause errors
     df <- bison(species = input$species, type = "scientific_name", start = 0, count =  df.init$georeferenced)
#      print("df")
#      print(head(df))
     print("extractgeo")
    geo <- bison_data(df, "data")
#      print("geo")
#      print(geo)
      geo$latitude <- as.numeric(as.character(geo$latitude))
     geo$longitude <- as.numeric(as.character(geo$longitude))
     geo$latlong <- paste0(geo$latitude,":",geo$longitude)
     #print("looks good")
    # print(geo)
     
     # state info
     print(df$counties$total)
     if (df$counties$total >0) {
     states <- bison_data(df, datatype = "counties")
    # print(states)
     states$total <- as.integer(states$total)
     # there are ties for max so cannot do ddply on matching - transform and then take first for
     # each on ordered
     states.summary <- ddply(states,"state", transform, tot=sum(total),max=max(total))
     states.summary <- arrange(states.summary,desc(total))
     temp <- ddply(states.summary,"state", function(x) c(county_name=x$county_name[1]) )
     #prob a simpler way but can then do merge
     
     df.states <- merge(temp,states.summary,by=c("state","county_name"),all.x=TRUE)[,c(1,5,2,4)]
     df.states <- arrange(df.states,desc(tot))
    # print(df.states)
     colnames(df.states) <- c('State','Total','Top','County')
     } else {
       df.states <- data.frame(State="No Data",Total=0,Top=0,County="")
     }
     print("dfstates")
    print(df.states)
     
     ## sighting methods get rid of centroid
    method <- bison_data(df)
     method["centroid"] <- NULL
     print(method)
     #plotHeight=200
    
     info=list(df=df,geo=geo,df.states=df.states,method=method) #plotHeight=plotHeight
     return(info)
     print("info returned")
        })
 
 output$statePlot <- renderPlot( {
   print("enterPlot")
#    print(input$goButton)
#    if (input$goButton == 0)
#      return()
   if (is.null(input$species)) return(invisible()) # no better than return(NULL) or return(())
   if (theData()$df$georeferenced==0) return(invisible())
   if (theData()$df$counties$total ==0) {
     return(invisible())
     
   }            
   #theHeight <<- 400
   print(bisonmap(theData()$df, tomap = "state"))

  }) #height=200 does impact
   
   output$stateInfo <- renderText({
     print("entercaption")
     if (is.null(input$species)) return(NULL)
     if (theData()$df$counties$total ==0) {
       "No State info available. Check Location or Google Maps"
     }
     else  if (theData()$df$georeferenced!=0) {
    paste0("Plot of the ",theData()$df$georeferenced," georeferenced occurrences out of a total ",theData()$df$total," sightings")
     } else if (theData()$df$total==1) {
       "The only sighting was not geo-referenced"
     } else {
       paste0("Out of ",theData()$df$total," sightings, none have been geo-referenced")
     }
     })
     
   
   
   output$stateCaption <- renderText({
     print("entercaption")
     if (is.null(input$species)) return(NULL)
  #    paste0(theData()$df$data[[1]]$common_name," - ",theData()$df$data[[1]]$name) works but some have multiple names
     
    # paste0(input$common," - ",input$species)
     
     
   })
  
  output$countyPlot <- renderPlot( {
    print("enterPlot")
    if (is.null(input$species)) return(NULL)
    if (theData()$df$georeferenced==0) return(NULL)
    print(bisonmap(theData()$df, tomap = "county"))
    
  })
  
  output$countyInfo <- renderText({
    print("entercaption")
    if (is.null(input$species)) return(NULL)
    if (theData()$df$georeferenced!=0) {
      paste0("Plot of the ",theData()$df$georeferenced," georeferenced occurrences out of a total ",theData()$df$total," sightings")
    } else if (theData()$df$total==1) {
      "The only sighting was not geo-referenced"
    } else {
      paste0("Out of ",theData()$df$total," sightings, none have been geo-referenced")
    }
  })
  
  
  
  output$countyCaption <- renderText({
    print("entercaption")
    if (is.null(input$species)) return(NULL)
    #    paste0(theData()$df$data[[1]]$common_name," - ",theData()$df$data[[1]]$name) works but some have multiple names
    
    paste0(input$common," - ",input$species)
    
    
  })
  
  output$locationPlot <- renderPlot( {
    if (is.null(input$species)) return(NULL)
    if (theData()$df$georeferenced==0) return(NULL)
    #print(theData()$df)
    bisonmap(theData()$df)  
  })
  
  output$locationInfo <- renderText({
    print("entercaption")
    if (is.null(input$species)) return(NULL)
    if (theData()$df$georeferenced!=0) {
      paste0("Plot of the ",theData()$df$georeferenced," georeferenced occurrences out of a total ",theData()$df$total," sightings")
    } else if (theData()$df$total==1) {
      "The only sighting was not geo-referenced"
    } else {
      paste0("Out of ",theData()$df$total," sightings, none have been geo-referenced")
    }
  })
  
  #https://gist.github.com/ramnathv/ab62aa00fc446239c16d and imageTest app
  output$image = renderUI({
    # input$common will be indeterminate - try input$species
    if (is.null(input$species)) return()
    speciesURL <-paste0("http://en.wikipedia.org/wiki/",input$species)
    basicInfo <- htmlParse(speciesURL, isURL = TRUE)
    url <-data.frame(xpathSApply(basicInfo, '//*/td[@colspan="2"]/a/img/@src'))[1,1]
    src <- paste0("http:",url)
   # print(src)
   # works src= "http://upload.wikimedia.org/wikipedia/commons/thumb/6/6e/Canadian_Rockies_-_the_bear_at_Lake_Louise.jpg/220px-Canadian_Rockies_-_the_bear_at_Lake_Louise.jpg"
    #cat(sprintf('<img src=%s></img>', src))
    tags$img(src=src)
    #"some text" doesnt just add
  })
  
  output$imageText = renderUI({
    if (is.null(input$species)) return(NULL)
    id <- str_replace(input$common," ","_")
    a(paste0("More Info at Wikipedia"), href=paste0("http://en.wikipedia.org/wiki/",id))
  })
  
  output$locationCaption <- renderText({
    print("entercaption")
    if (is.null(input$species)) return(NULL)
    #    paste0(theData()$df$data[[1]]$common_name," - ",theData()$df$data[[1]]$name) works but some have multiple names
    
    paste0(input$common," - ",input$species)
    
    
  })

  
  output$gvisPlot <- renderGvis( {
    ("enter loc plot")
    gvisMap(theData()$geo,locationvar="latlong","provider", options=list(mapType='normal')) # could get other info than provider probably with bit of munging
    
  })
  
  output$gvisInfo <- renderText({
    print("entercaption")
    if (is.null(input$species)) return(NULL)
    if (theData()$df$georeferenced!=0) {
      paste0("Plot of the ",theData()$df$georeferenced," georeferenced occurrences out of a total ",theData()$df$total," sightings")
    } else if (theData()$df$total==1) {
      "The only sighting was not geo-referenced"
    } else {
      paste0("Out of ",theData()$df$total," sightings, none have been geo-referenced")
    }
  })
  
  
  
  output$gvisCaption <- renderText({
    print("entercaption")
    if (is.null(input$species)) return(NULL)
    #    paste0(theData()$df$data[[1]]$common_name," - ",theData()$df$data[[1]]$name) works but some have multiple names
    
    paste0(input$common," - ",input$species)
    
    
  })

  output$summary <- renderGvis({
    gvisTable(theData()$df.states)
  })
  
  output$method <- renderGvis({
    gvisTable(theData()$method,options=list(height=100))
  })
  
#   output$misc <- renderUI({
#    paste0("fossil = petrified evidence of a species occurrence in geological time ",
#     a(paste0("Reference Manual"), href=paste0("http://cran.r-project.org/web/packages/", input$package,"/", input$package,".pdf")))
#   })
#   
})

ui.r

require(shiny)

shinyUI(pageWithSidebar(
  
  headerPanel(""),
  
  
  sidebarPanel(    
#     tags$head(
#       tags$link(rel = 'stylesheet', type = 'text/css', href = 'styles.css'),
#       tags$link(rel = 'stylesheet', type = 'text/css', href = 'appStyles.css') # yet to get working
#       
#     ),
    p("The",  a('rOpenSci initiative', href='http://ropensci.org/', id="link"),"  have developed an easy method to access 
", a('US Geological Survey', href='http://bison.usgs.ornl.gov/', id="link")," records for 
             more than 70,000 species of flora and fauna in the USA"),
    p("Enter a common name, press the button, select from the
             options provided and re-press"),
    p("Be as precise as possible e.g 'Black bear' gives 4 
             alternatives, 'bear' more than 800"),
    textInput("common", "Enter Common Name (can be slow response)"),
    uiOutput("selection"),
    submitButton("Go"),
    # actionButton("goButton","Go"),
    p(),
    
    
    htmlOutput("image"),
    uiOutput("imageText")
  ),
  
  
  mainPanel(
    tabsetPanel(
      tabPanel("State Map",
               h4(textOutput("stateCaption")),
               plotOutput("statePlot"),
               h5(textOutput("stateInfo")),
               value = 1),
      tabPanel("Tables",
               
               tableOutput("method"),
               tableOutput("summary"),
               
               
               value=2),
      tabPanel("County Map (be patient!)",
               h4(textOutput("countyCaption")),
               plotOutput("countyPlot"),
               h5(textOutput("countyInfo")),
               value = 3),
      tabPanel("Location (inc. Alaska)",
               h4(textOutput("locationCaption")),
               plotOutput("locationPlot"),
               h5(textOutput("locationInfo")),
               value = 4),
      tabPanel("Google Map (inc. Alaska)",
               h4(textOutput("gvisCaption")),
               htmlOutput("gvisPlot"),
               h5(textOutput("gvisInfo")),
               value = 5),
      tabPanel("Notes",
               # img(src="blankMap.png"), testing and oes work
               
               HTML("<h5>Definitions</h5
                        <ul>
                       <li>Fossil: Petrified evidence of a species occurrence in geological time </li>
                       <li>Specimen: The species or a part of it has been collected from this location and preserved in a formal collection</li>
                       <li>Germplasm: Living tissue from which new organisms can be grown </li>
                      <li>Literature: Assertion in a scientific publication of an occurrence </li>
                      <li>Living: Organism kept in captivity at the given location </li>
                       <li>Observation: A free-living species occurrence that does not produce a specimen or germplasm </li>
                       </ul>
                       <br>
                       Data may have been collected over many decades
                Scientific studies in a particular region may bias results
                       <br><br>
                       R packages used: shiny, rbison, taxize_, rjson, XML, googleVis, plyr, stringr
                  <br><br>
                    Special thanks to Scott Campbell of OpenSci
                    "),
               
               value = 6),
      id="tabs1")    
  ) 
  
))