Trump acceptance speech wordcloud via R

Used some simple R to create this

Wordcloud of the Trump acceptance speech at the Republican Convention.

Wordcloud of the Trump acceptance speech at the Republican Convention.

Not alot of insight to be had. Possibly because of the teleprompter he used.

 

Code:

setwd("~/cloud/R/")
aFile = readLines("trumpacceptance.txt")
library(tm)
library("SnowballC")
myCorpus = Corpus(VectorSource(aFile))
myCorpus = tm_map(myCorpus,  content_transformer(tolower))
myCorpus = tm_map(myCorpus, removePunctuation)
myCorpus = tm_map(myCorpus, removeNumbers)
myCorpus = tm_map(myCorpus, removeWords, stopwords("english"))
myCorpus <- tm_map(myCorpus, PlainTextDocument)
myDTM = TermDocumentMatrix(myCorpus, control = list(minWordLength = 1))

m = as.matrix(myDTM)
v = sort(rowSums(m), decreasing = TRUE)

library(wordcloud)
set.seed(4333)
d <- data.frame(word = names(v),freq=v)
wordcloud(words = d$word, freq = d$freq, min.freq = 1,  max.words=200, random.order=FALSE, rot.per=0.35,  colors=brewer.pal(8, "Dark2"))

Posted in R and tagged , , by with comments disabled.

Plotting Climate Change On A spider Graph using R

First, this is not original work. I must give credit to Ed on it. He made the original graph here http://www.climate-lab-book.ac.uk/2016/spiralling-global-temperatures/

So I’ve made some tweaks of work by Ed, to automate the data ingest.

Climate Change Spider Graph 2016The code I used was here

list.of.packages <- c("ggplot2", "dplyr", "tidyr","animation","ggvis")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)
library(dplyr)
library(tidyr)
library(ggplot2)
library(animation)
setwd("~/cloud/R/climate change/")
#Data from https://crudata.uea.ac.uk/cru/data/temperature/
#As well as data read in script
source("read_cru_hemi.r")
url_dat <- "https://crudata.uea.ac.uk/cru/data/temperature/HadCRUT4-gl.dat"
temp_dat <- read_cru_hemi(url_dat)

#temp_dat <- read_cru_hemi("./HadCRUT4-gl.dat")

#remove cover
temp_dat_monthly <- temp_dat %>%
  select(-starts_with("cover")) %>%
  select(-starts_with("annual")) %>%
  gather(month, anomaly, -year) %>%
  mutate(month = gsub("month\\.", "", month)) %>%
  mutate(month = as.numeric(month)) %>%
  filter(year !=2016)

mo <- months(seq(as.Date("1910/1/1"), as.Date("1911/1/1"), "months"))
mo <- gsub("(^...).*", "\\1", mo)

saveGIF({
  
#  for(i in 1850:2015){
  for(i in 1850:2016){
    print(ggplot(temp_dat_monthly %>% filter(year <= i), 
           aes(x=month, y=anomaly, color=year, group=year)) +
        geom_line() +
          #scale_color_gradient(low="blue", high="red", limits=c(1850, 2015), guide="none") +
        scale_color_gradient(low="blue", high="red", limits=c(1850, 2016), guide="none") +
        geom_hline(yintercept=1.5, color="black", lty=2) +
        geom_hline(yintercept=2, color="black", lty=2) +
        coord_polar() +
        annotate(x=1, y=-1.5, geom="text", label=i) +
        annotate(x=1, y=1.5, geom="label", label="1.5C", fill="white", label.size=0) +
        annotate(x=1, y=2, geom="label", label="2.0C", fill="white", label.size=0) +
          ggtitle(expression(atop("Global Temperature Change 1850-2016, East Anglia's HadCRUT4-gl.dat", atop(italic("by McCartney Taylor 11JUL16"), "")))) +
    #    ggtitle("Global Temperature Change 1850-2016 using University of East Anglia's HadCRUT4-gl.dat") +
        scale_x_continuous(labels=mo, breaks=1:13) +
        scale_y_continuous(labels=NULL, breaks=NULL) +
         ylab("") + xlab("")
       
  )}
}, interval=0.1)
  

And you'll need to download and create read_cru_hemi.r

# read_cru_hemi.r
#
# Reads a CRU-format hemispheric average file, as provided at
# http://www.cru.uea.ac.uk/cru/data/temperature
#
# Format has two lines for each year.
#  1) monthly mean anomalies plus an annual mean
#  2) coverage percentages
#
# Returns a data frame with columns:
#  year (1850 to final year)
#  annual (mean annual anomaly)
#  month.1 ... month.12 (mean monthly anomaly)
#  cover.1 ... cover.12 (percentage coverage)
#
read_cru_hemi <- function(filename) {
  # read in whole file as table
  tab <- read.table(filename,fill=TRUE)
  nrows <- nrow(tab)
  # create frame
  hemi <- data.frame(
    year=tab[seq(1,nrows,2),1],
    annual=tab[seq(1,nrows,2),14],
    month=array(tab[seq(1,nrows,2),2:13]),
    cover=array(tab[seq(2,nrows,2),2:13])
  )
  # mask out months with 0 coverage
  hemi$month.1 [which(hemi$cover.1 ==0)] <- NA
  hemi$month.2 [which(hemi$cover.2 ==0)] <- NA
  hemi$month.3 [which(hemi$cover.3 ==0)] <- NA
  hemi$month.4 [which(hemi$cover.4 ==0)] <- NA
  hemi$month.5 [which(hemi$cover.5 ==0)] <- NA
  hemi$month.6 [which(hemi$cover.6 ==0)] <- NA
  hemi$month.7 [which(hemi$cover.7 ==0)] <- NA
  hemi$month.8 [which(hemi$cover.8 ==0)] <- NA
  hemi$month.9 [which(hemi$cover.9 ==0)] <- NA
  hemi$month.10[which(hemi$cover.10==0)] <- NA
  hemi$month.11[which(hemi$cover.11==0)] <- NA
  hemi$month.12[which(hemi$cover.12==0)] <- NA
  #
  return(hemi)
}

Posted in musings, R and tagged , by with no comments yet.