Just after I made my really ugly animated turkey sketch (see post), I saw this much better set of Christmas icons in the Smashing Magazine Article Freebie Christmas Icon Set from Manuela Langella. While I still remember how to do this, I thought I would use the same techniques in R using rvest + XML + htmltools to animate the paths with vivus.js. In the iframe below is the result on the Santa icon.
Code: http://gist.github.com/39394d6e37a7fd878cab#file-code-R
I did not intend for this little experiment to become a post, but I think the code builds nicely on the XML + rvest combination (also see yesterday’s post) for working with XML/HTML/SVG documents in R.
It all started when I was playing on my iPhone in the Sketchbook app and drew a really bad turkey. Even though, the turkey was bad, I thought it would be fun to combine with vivus.js. However, Sketchbook does not export SVG, so I exported as PDF and imported into Inkscape. The end result was a still very messy SVG file, so I thought it would be a great test / application of my new skills with rvest + XML. The code opens the SVG, grabs all the path nodes, assembles those into a svg tag with id = "turkey", and then adds a script to use the addDependency for vivus.js.
Happy Thanksgiving to all the US readers out there.
As much as I would like to completely replace all tables with beautiful, intuitive, and interactive charts, tables like cockroaches cannot be eliminated. Based on this very interesting discussion on the Perceptual Edge forum with source Exploring the Origins of Tables for Information Visualization, tables date back to 1850 BCE. The paper concludes with
As part of exploration, tables help answer questions about data. As exemplars of communication, tables provide effective means for presenting data - each table has a story or stories to tell.
After struggling to create some attractive tables in HTML with R, I'm not sure they are any easier to create almost 4,000 years later. LaTeX is the clear winner when it comes to the table making competition. I have used xtable for HTML tables, but it could not fully produce a complicated table. I was delighted to recently find the Gmisc package, which is the result of a frustrated orthopaedic surgeon's need to create tables in Word for journal submission.
Another R to Word workflow was also discussed in Writing a MS-Word document using R (with as little overhead as possible). I was not aware of the need to produce a Word .doc from R. I simply thought creating an html table should not be that hard.
If you read Old Price Tables in Modern d3 Visualization and Dust off 130 Year Old Gold Books on Google Bookshelf, you'll know that my new favorite book is Gold and Prices Since 1873 by James Laurence Laughlin. This table on page 26 seems easy enough to recreate.
I had no idea how recreating this table would test and enhance my R skills. I started by manually entering the data since OCR did not work.
reps = c("http://ftp.sunet.se/pub/lang/CRAN", "http://cran.gforge.se")
install.packages("Gmisc", repos = reps, dependencies = TRUE)
library(Gmisc, verbose = FALSE)
# manually enter the data in a data frame
data1874 <- data.frame(c(1872, 1874, 1869, 1870, 1870, 1871, 1871, 1871, 1870,
1873, 1872, 1871), c(153825, 41380, 131800, 15447, 4893, 2109, 16651, 80361,
1749, 7058, 3801, 18900), c(0, 0, 106600, 33695, 14230, 55320, 37160, 4775,
4325, 1535, 6980, 0), c(198540, 20580, 274100, 88487, 40505, 62857, 119000,
429486, 7327, 11794, 16877, 284561))
rownames(data1874) <- c("Banks of the United Kingdom", "Banks of Australia",
"Banks of France", "Banks of Italy", "National Bank of Belgium", "Bank of the Netherlands",
"Bank of Austria-Hungary", "Imperial State Bank of Russia", "Imperial Bank of Sweden",
"Bank of Norway", "National Bank of Denmark", "National Bank of the United States")
colnames(data1874) <- c(" ", "Gold", "Silver", "Total Note Circulation")
data1885 <- data.frame(c(141205, 65890, 231483, 56121, 13900, 19161, 25902,
102207, 3436, 7169, 11566, 158100), c(0, 0, 217087, 11203, 6540, 38366,
48646, 676, 777, 0, 846, 7900), c(186850, 28115, 583610, 189690, 73400,
76972, 136351, 429860, 9835, 9287, 18370, 276500))
colnames(data1885) <- colnames(data1874)[2:4]
# get sums for totals row in table
data1874[NROW(data1874) + 1, ] = apply(data1874, MARGIN = 2, FUN = sum)
data1885[NROW(data1885) + 1, ] = apply(data1885, MARGIN = 2, FUN = sum)
# add Total to row names
rownames(data1874)[NROW(data1874)] = "Total"
rownames(data1885)[NROW(data1885)] = "Total"
# eliminate the sum of years which does not make sense
data1874[NROW(data1874), 1] = ""
# get commas in the numbers
data1874[, 2:4] <- format(data1874[, 2:4], big.mark = ",")
data1885 <- format(data1885, big.mark = ",")
Then with gmisc I very quickly achieved a decent table.
# use htmlTable to produce a table
htmlTable(cbind(data1874, data1885), caption = "", rowlabel = "", cgroup = c("Reserves",
"", "Reserves", ""), n.cgroup = c(3, 1, 2, 1, 0), ctable = TRUE, output = TRUE)
However, the complicated multiple row heading was still missing, so here is the much harder brute force work to parse the HTML to get the table structured correctly.
# do all the hard work to make the table more of an exact replica
gtable_table <- htmlTable(cbind(data1874, data1885), caption = "", rowlabel = "",
cgroup = c("Reserves", "", "Reserves", ""), n.cgroup = c(3, 1, 2, 1, 0),
ctable = TRUE, output = FALSE)
require(XML)
# parse the table so that we can access the elements in a very crude
# manner
doc <- htmlParse(gtable_table)
# add another row heading to the table with XML
temp <- addChildren(getNodeSet(doc, "//thead")[[1]], newXMLNode("tr", list(newXMLNode("th",
attrs = list(colspan = "1", style = "font-weight: 900; border-top: 2px solid grey;border-right: 1px solid grey;"),
text = ""), newXMLNode("th", attrs = list(colspan = "6", style = "font-weight: 900; border-top: 2px solid grey;"),
text = "1870-1874"), newXMLNode("th", attrs = list(colspan = "5", style = "font-weight: 900; border-top: 2px solid grey;"),
text = "1885"))), at = 0)
# add some vertical borders; wish this were easier but very manual
th <- getNodeSet(doc, "//thead//th") #start with the th elements in thead
for (i in c(1, 2, 4, 8, 12, 18)) {
oldstyle <- xmlAttrs(th[[i]])["style"] #get the old style attribute
removeAttributes(th[[i]], attrs = "style") #remove the style attribute
addAttributes(th[[i]], style = paste(oldstyle, "border-right: 1px solid grey;",
sep = "")) #add the old style attribute concatenated with border-right
}
th <- getNodeSet(doc, "//tbody//td") #now do the td elements in tbody
for (i in c(seq(1, 133, by = 11), seq(7, 139, by = 11))) {
oldstyle <- xmlAttrs(th[[i]])["style"] #get the old style attribute
removeAttributes(th[[i]], attrs = "style") #remove the style attribute
addAttributes(th[[i]], style = paste(oldstyle, "border-right: 1px solid grey;",
sep = "")) #add the old style attribute concatenated with border-right
}
# although htmlTable will group rows, I could not make it do what I wanted
# so add underline before the total row
for (i in 133:143) {
oldstyle <- xmlAttrs(th[[i]])["style"] #get the old style attribute
removeAttributes(th[[i]], attrs = "style") #remove the style attribute
addAttributes(th[[i]], style = paste(oldstyle, "border-top: 1px solid grey;",
sep = "")) #add the old style attribute concatenated with border-top
}
# for some reason becomes Â, so reverse it back to $nbsp;
returnHTML <- gsub("[Â].", replacement = " ", saveXML(getNodeSet(doc, "//table")[[1]]))
# not sure if necessary but free up doc from memory
free(doc)
cat(returnHTML)
This can be even further improved with some simple CSS. I hope this helps somebody. Oh, I just also remembered dprint which I will revisit soon. For now I think I'll go back to making graphs.
After reading Bloomberg’s article,
JPMorgan Chase & Co. and Goldman Sachs Group Inc., among the world’s biggest traders of credit derivatives, disclosed to shareholders that they have sold protection on more than $5 trillion of debt globally.
I thought we should update my post Scary Derivatives and Scary XML in R in which I said
The massive damage caused in 2008-2009 by the sliver of derivatives called credit default swaps seems like a faint warning siren when we see that they only represent < 7% of total derivatives exposure. Interest rate and currency derivatives, also where I think the next disaster occurs, are more than 10 times larger than these credit contracts at $226 Trillion.
 |
| From TimelyPortfolio |
This amount of money, bilaterally netted or not, is truly unbelievable and staggering. Total debt outstanding of the sovereign nations is not the real problem. Like housing, the exponential exacerbation caused by the leverage and derivatives traded on the underlying is where the real potential catastrophe occurs. No government and no central bank has the ability to counter any major damage in currencies or interest rates.
R code (click to download from Google Docs):
#read xml derivatives data from the
#US Treasury OCC Quarterly Derivatives Report
#2 methods
#still way too manual since it appears the format changes
#each reporting period
#as far as I can tell
#the first published example of how to read
#Microsoft Excel xml workbooks
require(XML)
#require(ggplot2)
#get 2nd Quarter of 2011 report (dq211)
url = "http://www.occ.treas.gov/topics/capital-markets/financial-markets/trading/derivatives/dq211-xml.xml"
doc = xmlInternalTreeParse(url)
#define namespaces
#figuring this out took hours
#but using getNodeSet was much cleaner than the
#next method
namespaces = c(o="urn:schemas-microsoft-com:office:office",
x="urn:schemas-microsoft-com:office:excel",
ss="urn:schemas-microsoft-com:office:spreadsheet",
html="http://www.w3.org/TR/REC-html40")
#this gets row 41 from the Table 3 worksheet for the total $ of derivatives
ns <- getNodeSet(doc,"/ss:Workbook/ss:Worksheet[@ss:Name='Table 3']/ss:Table/ss:Row",namespaces)[[41]]
amt <- df <- as.data.frame(as.numeric(xmlSApply(ns, xmlValue))[4:11])
#believe it or not this is $trillions of dollars
#remove some zeros so we can label better on the graph
amt <- amt/1000000
df <- df/1000000
#this gets row 10 for labels
ns <- getNodeSet(doc,"/ss:Workbook/ss:Worksheet[@ss:Name='Table 3']/ss:Table/ss:Row",namespaces)[[10]]
lab <- as.character(xmlSApply(ns, xmlValue)[4:11])
#combine the labels with
df <- cbind(lab,df)
#jpeg(filename="derivatives by type.jpg",quality=100,
# width=6.25, height = 8, units="in",res=96)
barplot(df[5:8,2],names.arg = factor(df[5:8,1]),main="US Bank Derivatives by Type
Q2 2011",ylab="$ (in trillions)",ylim=c(0,max(df[5:8,2]+50)),space=0,
col=c("indianred4","darkolivegreen4","cadetblue4","goldenrod3"))
mtext("Source: US Dept of Treasury OCC Quarterly Derivatives Report",
side=1,line=3,cex=0.8,adj=0)
#dev.off()