#### Dec 22nd Finally measuring Earth using trigonometry

Eratosthenes measured the world using shadows cast in two different cities at the same time. I’ve been wanting to replicate it for over  decade. Today I did. 5 volunteers from San Diego to Nashville all have the same style of pencil of the same length. Everyone is to measure the shadow on it at noon CST.  Today only 2 could do it. From the data, I have computed the following:

circumference_earth – 32744.22 miles
> real_circumference_earth<-24901 miles

Error:    0.3149762

So a rough, but useful first attempt. The R code I’m using is:

```#computing circumference of earth

library(dplyr)
library(tidyr)
library(ggplot2)
library(animation)
setwd("~/Copy/R/climate change/")

real_circumference_earth<-24901
data<-data[,-1]
pencil<- 19.0
avg_data<-(colMeans(data))
str(data)
avg_data
angle_mt<-180-90-atan(pencil/avg_data)/(2*pi/360)
angle_tc<-180-90-atan(pencil/avg_data)/(2*pi/360)
net_angle_tc<-angle_tc-angle_mt
angle_mt
angle_ratio_to_tc<-360/abs(net_angle_tc)
distance_trevor<-651.0
earth_circ_per_tc<-distance_trevor*angle_ratio_to_tc
earth_circ_per_tc
err_per_tc<-(earth_circ_per_tc-real_circumference_earth)/real_circumference_earth*100
err_per_tc

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

#### Sep 16th Trump acceptance speech wordcloud via R

Used some simple R to create this 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/")
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.

#### Jul 11th 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.

```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

#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)

```

```# 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 in whole file as table
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.