###
### Perception
###

## A simple perception example
x <- seq(0, 2*pi, len = 100)
y <- sin(x)
d <- 0.2 - sin(x+pi/2) * 0.1
plot(x,y,type="l", ylim = c(-1,1.2))
lines(x, y + d, col = "red")
lines(x, d, col = "blue", lty = 2)


###
### Bloomberg Data
###
# http://homepage.stat.uiowa.edu/~luke/classes/STAT7400/examples/shrinking-banks.pdf

## improved version of the second row
library(ggplot2)
bankName <- c("Credit Suisse", "Goldman Sachs", "Santander",
              "Citygroup", "JP Morgan", "HSBC")
before <- c(75, 100, 116, 255, 165, 215)
after <- c(27, 35, 64, 19, 85, 92)

d <- data.frame(cap = c(before, after),
                year = factor(rep(c(2007,2009), each=6)),
                bank = rep(reorder(bankName, 1:6), 2))

ggplot(d, aes(x = year, y = bank, size = cap, col = year)) +
    geom_point() +
    scale_size_area(max_size = 20) +
    scale_color_discrete(guide="none") 

## a bar chart:
ggplot(d, aes(x = bank, y = cap, fill = year)) +
    geom_bar(stat = "identity", position = "dodge") + coord_flip()

## some dot plots:
qplot(cap, bank, col = year, data = d)
qplot(cap, bank, col = year, data = d) + geom_point(size = 4)
do <- transform(d, bank = reorder(bank,rep(cap[1:6],2)))
qplot(cap, bank, col = year, data = do) +
    geom_point(size = 4)
qplot(cap, bank, col = year, data = do) +
    geom_point(size = 4) + theme_bw()
library(ggthemes)
qplot(cap, bank, col = year, data = do) +
    geom_point(size = 4) + theme_economist()
qplot(cap, bank, col = year, data = do) +
    geom_point(size = 4) + theme_wsj()


###
### Temperature Data
###

## Optaining the current temperature at a latitude and longitude from
## Open Weather Map (http://api.openweathermap.org)
library(xml2)
findTempOWM <- function(lat, lon) {
    base <- "http://api.openweathermap.org/data/2.5/weather"
    key <- "44db6a862fba0b067b1930da0d769e98"
    url <- sprintf("%s?lat=%f&lon=%f&mode=xml&units=Imperial&appid=%s",
        base, lat, lon, key)
    page <- read_xml(url)
    as.numeric(xml_text(xml_find_one(page, "//temperature/@value")))
}

findTempOWM(41.7, -91.5)

## Obtaining the current temerature for a named city from weather.gov
library(xml2)
findTempGov <- function(citystate) {
    url <- paste("http://forecast.weather.gov/zipcity.php?inputstring",
                 url_escape(citystate),
                 sep = "=")
    page <- read_html(url)
    xpath <- "//p[@class=\"myforecast-current-lrg\"]"
    tempNode <- xml_find_one(page, xpath)
    as.numeric(sub("([-+]?[[:digit:]]+).*", "\\1", xml_text(tempNode)))
}

findTempGov("Iowa City,IA")

## A small selection of Iowa cities:
places <- c("Ames", "Burlington", "Cedar Rapids", "Clinton",
            "Council Bluffs", "Des Moines", "Dubuque", "Fort Dodge",
	    "Iowa City", "Keokuk", "Marshalltown", "Mason City",
	    "Newton", "Ottumwa", "Sioux City", "Waterloo")

## We can find their current temperatures with
temp <- sapply(paste(places, "IA", sep = ", "),
               findTempGov, USE.NAMES = FALSE)
temp

## We can optain a file of geocoded cities and read it into R:
## download.file("http://www.sujee.net/tech/articles/geocoded/cities.csv.zip",
##               "cities.csv.zip")
download.file("http://www.stat.uiowa.edu/~luke/classes/STAT7400/data/cities.csv.zip",
              "cities.csv.zip")
unzip("cities.csv.zip")
cities <- read.csv("cities.csv", stringsAsFactors=FALSE, header=FALSE)
names(cities) <- c("City", "State", "Lat", "Lon")
head(cities)

## Form the temperature data into a data frame and merge in the
## locations from the cities data frame
tframe <- data.frame(City = toupper(places), State = "IA", Temp = temp)
tframe

temploc <- merge(tframe, cities,
                 by.x = c("City", "State"), by.y = c("City", "State"))
temploc

## use the map() function from the maps package along with text() to
## show the results:
library(maps)
map("state", "iowa")
with(temploc, text(Lon, Lat, Temp, col = "blue"))

## To add contours we can use interp() from the akima package and the
## contour() function:
library(akima)
map("state", "iowa")
surface <- with(temploc, interp(Lon, Lat, Temp, linear = FALSE))
contour(surface, add = TRUE)
with(temploc, text(Lon, Lat, Temp, col = "blue"))

## ggmap version:
library(ggmap)
p <- qmplot(Lon, Lat, label = Temp, data = temploc, 
            zoom = 7, source = "google") +
    geom_text(color="blue", vjust = -0.5, hjust = -0.3, size = 7)
p

s <- expand.grid(Lon = surface$x, Lat = surface$y)
s$Temp <- as.vector(surface$z)
s <- s[! is.na(s$Temp),]
p + geom_contour(aes(x = Lon, y = Lat, z = Temp), data = s)


###
### Presidential Elections
###

## Extract the table of results and form into a data frame:
library(XML)
url <- "http://elections.nytimes.com/2008/results/states/president/iowa.html"
tab <- readHTMLTable(url, stringsAsFactors = FALSE)[[1]]

library(xml2)
library(rvest)
tab <- html_table(read_html(url))[[1]]

iowa <- data.frame(county = tab[[1]],
                   ObamaPCT = as.numeric(sub("%.*", "", tab[[2]])),
                   ObamaTOT = as.numeric(gsub("votes|,", "", tab[[3]])),
                   McCainPCT = as.numeric(sub("%.*", "", tab[[4]])),
                   McCainTOT = as.numeric(gsub("votes|,", "", tab[[5]])),
                   stringsAsFactors = FALSE)
head(iowa)

## need to match the county data to the county regions
library(maps)
cnames <- map("county", "iowa", namesonly = TRUE, plot = FALSE)
head(cnames)

## compare them to the names in the table:
which( ! paste("iowa", tolower(iowa$county), sep = ",") == cnames)
cnames[71]
iowa$county[71]

## choose cutoffs for the percentage differences and assign codes:
cuts <- c(-100, -15, -10, -5, 0, 5, 10, 15, 100)
buckets <- with(iowa, as.numeric(cut(ObamaPCT - McCainPCT, cuts)))

## create a diverging color palette and assign the colors:
palette <- colorRampPalette(c("red", "white", "blue"),
                            space = "Lab")(8) 
colors <- palette[buckets]

## create the map:
map("county", "iowa", col = colors, fill = TRUE)

## versions with no county lines and with the county lines in white:
map("county", "iowa", col = colors, fill = TRUE, lty = 0, resolution=0)
map("county", "iowa", col = "white", add = TRUE)

## a better pallette:
myred <- rgb(0.8, 0.4, 0.4)
myblue <- rgb(0.4, 0.4, 0.8)
palette <- colorRampPalette(c(myred, "white", myblue),
                            space = "Lab")(8) 
colors <- palette[buckets]
map("county", "iowa", col = colors, fill = TRUE, lty = 0, resolution=0)
map("county", "iowa", col = "white", add = TRUE)


###
### ITBS Results for Iowa City Elementary Schools
###

## Read in the Standard results:
url <- paste("http://www.stat.uiowa.edu/~luke/classes/STAT7400",
             "examples/ITBS/ICPC-ITBS-Standard.csv", sep = "/")
Standard <- read.csv(url, stringsAsFactors = FALSE, row.names = 1)
names(Standard) <- sub("X", "", names(Standard))
head(Standard)

## convert from 'wide' to 'long' format
library(reshape2)
mS <- melt(Standard, id=c("Grade", "Test", "School"),
           value.name = "Score", variable.name = "Year")
head(mS)

## Some Lattice plots:
library(lattice)
xyplot(Score ~ Grade | Year, group = Test, type = "l", data = mS,
       auto.key = TRUE)
xyplot(Score ~ Grade | Year, group = Test, type = "l", data = mS,
       subset = School == "Lincoln", auto.key = TRUE)
xyplot(Score ~ Grade | Year, group = Test, type = "l", data = mS,
       subset = Test %in% c("SocialScience", "Composite"),
       auto.key = TRUE)


###
### Sochi Olympic Medals
###
### From http://trinkerrstuff.wordpress.com/2014/02/09/sochi-olympic-medals-2/
###
### Follow-up posts:
### http://blog.revolutionanalytics.com/2014/02/winter-olympic-medal-standings-presented-by-r.html
### http://rud.is/b/2014/02/11/live-google-spreadsheet-for-keeping-track-of-sochi-medals/

## library(XML)
## library(reshape2)
## library(ggplot2)

## ## Grab and clean the data
## url <- "http://www.sochi2014.com/en/medal-standings"
## raw <- readHTMLTable(url, header = FALSE, 
##                      colClasses = c(rep("factor", 2), rep("numeric", 4)))
## raw <- as.data.frame(raw)[, -1]
## colnames(raw) <- c("Country", "Bronze", "Silver", "Gold", "Total")
## raw <- raw[order(raw[, "Total"]), ]
## raw[, "Country"] <- factor(raw[, "Country"], levels = raw[, "Country"])
## rownames(raw) <- NULL
## nzraw <- raw[raw[, "Total"] != 0, ]
## head(nzraw)

## ## Plot the Data
## mdat <- melt(nzraw, value.name = "Count",
##              variable.name = "Place", id.var = "Country")
## ggplot(mdat, aes(x = Count, y = Country, colour = Place)) +
##     geom_point(size = 4) +
##     facet_grid(.~Place) + theme_bw()+
##     scale_colour_manual(values=c("#CC6600", "#999999", "#FFCC33", "#000000")) 


###
### Symbolic Computation
###

## some simple exampes
e <- quote(x+y)
e

e[[1]]
e[[2]]
e[[3]]

e[[3]] <- as.name("z")
e

as.call(list(as.name("log"), 2))

## a rudimentary symbolic differentiator:
source("http://www.stat.uiowa.edu/~luke/classes/STAT7400/examples/derivs/d.R")

## simple examples:
d(quote(x), "x")
d(quote(y), "x")
d(quote(2 + x), "x")
d(quote(2 * x), "x")
d(quote(y * x), "x")

## things it cannot do yet:
d(quote(-x), "x")
d(quote(x/y), "x")
d(quote(x+(y+z)), "x")