surnames/server.R

#
# This is the server logic of a Shiny web application. You can run the 
# application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
# 
#    http://shiny.rstudio.com/
#

library(shiny)
library(rvest)

googleme_url <- function(first, last) {
  paste0("https://www.google.com/#q=%22", first, "+", last, "%22")
}

googleme <- function(first, last) {
  paste0('<a href="', googleme_url(first, last), 
         '" target="_blank"',
         #ifelse(is.null(class), "", paste0('class="',class,'"'), 
         '>',
         first, " ", last,"</a>")
}

# Define server logic required to draw a histogram
shinyServer(function(input, output, session) {
  
  surname.this <- reactive({
    surnames.final %>% filter(surname == input$surname)
  })
  
  surname.choices <- reactive({
    if (input$cluster == 'All') {
      surname_choices <- surnames.final$surname
    } else if (input$cluster == "Favorites - Ryan") {
      load('likes_ryan.RData')
      surname_choices <- likes_ryan
    } else if (input$cluster == "Favorites - Garrick") {
      load('likes_garrick.RData')
      surname_choices <- likes_garrick
    } else {
      surname_choices <- surnames.final %>% 
        filter(cluster_name == input$cluster) %>% .$surname
    }
    
    if (length(surname_choices) < 1) {
      surnames.final$surname
    } else {
      surname_choices
    }
  })
  
  # ---- Sidebar ----
  observe({
    updateSelectizeInput(session, 'surname', choices = surname.choices())
  })
  
  observeEvent(input$next_name, {
    surname_choices <- surname.choices()
    chosen <- which(input$surname == surname_choices)
    if (chosen == length(surname_choices)) chosen <- 0
    updateSelectizeInput(session, 'surname', selected = surname_choices[chosen+1])
  })
  
  observeEvent(input$random_name, {
    surname_choices <- surname.choices()
    chosen <- sample(1:length(surname_choices), 1)
    updateSelectizeInput(session, 'surname', selected = surname_choices[chosen])
  })
  
  observeEvent(input$like, {
    if (input$user == "Ryan") {
      load('likes_ryan.RData')
      likes_ryan <- union(likes_ryan, input$surname)
      save(likes_ryan, file = 'likes_ryan.RData')
    } else if (input$user == 'Garrick') {
      load('likes_garrick.RData')
      likes_garrick <- union(likes_garrick, input$surname)
      save(likes_garrick, file = 'likes_garrick.RData')
    }
  })
  
  # ---- Display ----
  output$t_header <- renderText({
    paste("Hi, <span class='text-danger'>", 
          googleme(input$user, input$surname), 
          "</span>")
  })
  
  output$t_othername <- renderText({
    us <- c('Garrick', 'Ryan')
    baby_text <- ""
    verb <- "is"
    if (input$baby != "") {
      verb <- "are"
      baby_text <- paste0(" and little <span class='text-info'>", 
                          googleme(input$baby, input$surname),  "</span>")
    }
    paste0("How ", verb, 
           " <span class='text-info'>", 
           googleme(us[which(us != input$user)], input$surname), 
           "</span>", baby_text, "?")
  })
  
  output$t_body <- renderText({
    match_score <- round(surname.this()$mean*100, 1)
    rnk_surname <- surname.this()$rank
    pop_surname <- surname.this()$count
    paste0("The last name ", 
           "<strong class='text-danger'>",
           input$surname,
           "</strong>",
           " scored ", 
           "<strong class='text-info'>",
           match_score, 
           "%</strong>",
           " in the match score,",
           " is shared by approximately ", 
           "<strong class='text-info'>",
           formatC(pop_surname, format = 'd', big.mark = ','),
           "</strong>",
           " people,",
           " and is the ", 
           "<strong class='text-info'>",
           formatC(rnk_surname, format = 'd', big.mark = ','), 
           "th</strong>",
           " most popoular name in the US",
           ".")
  })
  
  output$p_radar <- renderPlot({
    if (is.null(input$surname) | input$surname == "") return(NULL)
    plot.new()
    par(mfrow = c(1, 2), mai = c(0.1, 0.1, 0.3, 0.1))
    surname_data <- surname.this()
    radarplot(surname_data, TRUE)
    radarplot(surname_data, FALSE)
  })
  
  output$link_forebears <- renderText({
    paste0('Read more on <a href=http://forebears.io/surnames/', 
           tolower(input$surname), ' target="_blank">forebears.io...</a>')
  })
  
  output$forebears_name <- renderText({
    url <- paste0('http://forebears.io/surnames/', tolower(input$surname))
    def <- read_html(url) %>% 
      html_nodes(".surDesc p") %>% 
      html_text() %>% 
      paste(collapse = "</p><p>")
    if(def == "") return(NULL)
    paste0("<blockquote class='small'><p>", def, "</p></blockquote>")
  })
  
  output$t_surnames <- renderDataTable({
    surnames.final %>% 
      filter(surname %in% surname.choices()) %>% 
      select(-cluster, -cluster_name, -prop100k, -cum_prop100k)
  }, options = list(pageLength = 15))
  
})