Skip to content

Instantly share code, notes, and snippets.

@briatte
Last active August 29, 2015 13:55
Show Gist options
  • Save briatte/8766856 to your computer and use it in GitHub Desktop.
Save briatte/8766856 to your computer and use it in GitHub Desktop.
ggplot2 wrapper for http://porngram.sexualitics.org/ (uses elements from ngramr)
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)
}
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))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment