# # 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('', first, " ", last,"") } # 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, ", googleme(input$user, input$surname), "") }) output$t_othername <- renderText({ us <- c('Garrick', 'Ryan') baby_text <- "" verb <- "is" if (input$baby != "") { verb <- "are" baby_text <- paste0(" and little ", googleme(input$baby, input$surname), "") } paste0("How ", verb, " ", googleme(us[which(us != input$user)], input$surname), "", 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 ", "", input$surname, "", " scored ", "", match_score, "%", " in the match score,", " is shared by approximately ", "", formatC(pop_surname, format = 'd', big.mark = ','), "", " people,", " and is the ", "", formatC(rnk_surname, format = 'd', big.mark = ','), "th", " 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 forebears.io...') }) 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 = "
") if(def == "") return(NULL) paste0("
") }) output$t_surnames <- renderDataTable({ surnames.final %>% filter(surname %in% surname.choices()) %>% select(-cluster, -cluster_name, -prop100k, -cum_prop100k) }, options = list(pageLength = 15)) })", def, "