ggplot2 wrapper for http://porngram.sexualitics.org/ (uses elements from ngramr)

porngram.r

porngram <- function(x = c("hardcore", "softcore"), ..., adjust = "xxx") {
  library(ggplot2)
  library(XML)
  library(reshape)
  library(rPython)
  
  x = c(x, ...)
  if (length(x) > 10) {
    x <- x[1:10]
    warning("Porngram API limit: only using first 10 phrases.")
  }
  
  html = paste0("http://porngram.sexualitics.org/?q=", paste0(x, collapse = "%2C"))
  message(html)
  html = readLines(html, warn = FALSE)
  html = html [ which( grepl("google.visualization.arrayToDataTable", html) ) + 1 ]
  
  html = t(apply(as.matrix(python.get(html)), 1, unlist))
  data = data.frame(html[-1, ], stringsAsFactors = FALSE)
  names(data) = html[1, ]
  
  if(is.logical(adjust) | is.null(adjust)) adjust = ifelse(isTRUE(adjust), "porn", 0) # default
  if(is.character(adjust)) {
    html = readLines(paste0("http://porngram.sexualitics.org/?q=", adjust), warn = FALSE)
    html = html [ which( grepl("google.visualization.arrayToDataTable", html) ) + 1 ]
    html = t(apply(as.matrix(python.get(html)), 1, unlist))
    data[, -1] = as.numeric(as.matrix(data[, -1])) / as.numeric(html[-1 , 2])
    names(data)[-1] = paste0(names(data)[-1], " / ", html[1 , 2])
  }
  
  data = melt(data, "Year")
  data$value = as.numeric(as.character(data$value))
  
  # Google Ngram palette
  palette = c("#264EC0", "#D22310", "#FC8608", "#168713", "#850086", "#1086B9", 
              "#D22B63", "#559D05", "#A71B23", "#21436F")

  p = qplot(data = data, x = Year, y = value, group = variable, color = variable, geom = "line") +
    scale_colour_manual("", values = palette) +
    theme_grey(16) +
    theme(panel.background = element_rect(fill = NA),
          panel.grid.major.y = element_line(color = "grey"),
          panel.grid.minor = element_blank(),
          rect = element_blank(),
          legend.position= "bottom",
          axis.line = element_line(color = "black"),
          axis.text = element_text(color = "black"),
          axis.ticks = element_blank()) +
    labs(y = NULL, x = NULL)
  
  return(p)
}

porngram_examples.r

source("porngram.r")

# simple examples
porngram("asian", "american", "french", adjust = FALSE)
porngram("asian", "american", "french", adjust = "xxx")

# longer example
geo = porngram("asian", "japanese","american", "french", "german", "british", "italian", "dutch", adjust = "amateur")
ggsave("~/Desktop/geo.png", plot=last_plot() + theme(legend.position = "right"), width = 10)

# factor loadings
loadings(princomp(t(apply(t(cast(geo)), 1, diff))))
loadings(princomp(as.matrix(t(cast(geo)))))

# quick PCA plots
library(FactoMineR)
plot(PCA(as.matrix(t(cast(geo)))))
plot(PCA(t(apply(t(cast(geo)), 1, diff))))