initial commint

global.R

@@ -0,0 +1,45 @@
+library(shiny)
+library(ggplot2)
+library(fmsb)
+library(dplyr)
+
+load('surnames_final.RData')
+surnames.final <- surnames_final %>% 
+  filter(count >= 50,
+         mean >= 0.70,
+         white >= 45)
+
+OURNAMES <- c('adams', 'brenn', 'aden', 'buie')
+PROFILE  <- c('white', 'black', 'asian', 'native', 'multiple', 'hispanic')
+CLUSTER_NAMES <- surnames.final$cluster_name
+
+radarplot <- function(data, is_names = TRUE, ...) {
+  data[is.na(data)] <- 0
+  add_max_min_rows <- function(x, max, min) {
+    rbind(rep(max, length(x)), rep(min, length(x)), x)
+  }
+  if (is_names) {
+    data <- add_max_min_rows(data[, OURNAMES], 1, 0)
+    pcol.this  <- rgb(0.2,0.5,0.5,0.9)
+    pfcol.this <- rgb(0.2,0.5,0.5,0.5)
+    caxislabels.this <- seq(0,1,5)
+    title.this <- "Our Names"
+  } else {
+    data <- add_max_min_rows(data[, PROFILE], 100, 0)
+    pcol.this  <- "#36648BE6"
+    pfcol.this <- "#36648B80"
+    caxislabels.this <- seq(0,100,20)
+    title.this <- "Profile"
+  }
+  radarchart(data, title = title.this,
+             pcol = pcol.this, pfcol = pfcol.this,
+             plwd = 4,
+             cglcol = 'grey', cglty = 1,
+             axislabcol = "grey",
+             caxislabels = seq(0, 1, 5),
+             cglwd = 0.8,
+             vlcex = 0.8,
+             centerzero = TRUE,
+             ...
+  )
+}

server.R

@@ -0,0 +1,161 @@
+#
+# 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))
+  
+})

ui.R

@@ -0,0 +1,57 @@
+#
+# This is the user-interface definition 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)
+
+# Define UI for application that draws a histogram
+shinyUI(fluidPage(
+  
+  # Application title
+  titlePanel("Surname Navigator"),
+  
+  # Sidebar with a slider input for number of bins 
+  sidebarLayout(
+    sidebarPanel(width = 3,
+      selectInput('user', label = "Your Name", choices = c('Ryan', 'Garrick')),
+      textInput('baby', label = 'Baby Name', value = 'August'),
+      selectInput('cluster', label = "Name Combo", 
+                  choices = c("All", "Favorites - Ryan", "Favorites - Garrick", CLUSTER_NAMES)),
+      selectizeInput('surname', label = 'Surname', choices = surnames.final$surname),
+      actionButton('next_name', label = 'Next', width = '32%', class = 'btn-primary'),
+      actionButton('random_name', label = 'Random', width = "32%", class = 'btn-info'),
+      actionButton("like", label = 'Like!', width = "32%",
+                   icon = icon("thumbs-o-up"), class = 'btn-success')
+    ),
+    
+    # Main Panel
+    mainPanel(width = 9,
+      tabsetPanel(
+        tabPanel('Name Info',
+                 tags$h1(htmlOutput('t_header', inline = TRUE)),
+                 tags$h3(htmlOutput('t_othername', inline = TRUE)),
+                 tags$hr(),
+                 fluidRow(
+                   column(6, plotOutput("p_radar", height = '200px')),
+                   column(6, tags$p(htmlOutput('t_body', inline = TRUE), class = "h3"))
+                 ),
+                 tags$hr(),
+                 fluidRow(
+                   column(10,
+                          tags$h3('Definition'),
+                          htmlOutput('forebears_name'),
+                          tags$p(htmlOutput('link_forebears'), inline = TRUE)
+                   )
+                 )
+        ),
+        tabPanel("Explore Group",
+                 dataTableOutput('t_surnames'))
+      )
+    )
+  )
+))