Mark the Graph: Some of my charting programs

From time to time I get asked how do I make my graphs.

Let me begin with my production line. I keep the data from many sources (including the ABS and the RBA) in a data-warehouse. I load the data into the warehouse using a series of programs I wrote in python. The warehouse itself is maintained in MySQL. I use the data language R with the ggplot2 package to make the graphs. I originally developed my graphs production line under Linux, but it now operates on my MacBook Pro under OSX Lion. I mention the environment, as I use Unix shell programs to link the steps in the production process together.

In the remainder of this post, I will focus on the last bit of the production line: the production of the graphs.

The first program I use, one of the first I wrote for this exercise some three or four years ago, is a file to connect to the MySQL data-warehouse. I call this program from every one of my charting programs. You will see an example further down below.

The next program I use holds my core plotting constants and routines. This program is long and tedious, but it allows me to chart new data very quickly. It also allows me to maintain a consistent look and feel across the various charts I produce. Most of the standard charts you can see on this site are produced somewhere in this program. As with the connection to the database, this program is called by almost all of my charting programs.

###### i-plot-constants.R
######
###### - ------------------------------------------------
###### - Some useful plotting constants and functions ...
###### - ------------------------------------------------

# ----- the library
library(ggplot2)
library(gridExtra)
library(reshape)
library(plyr)

# ----- preferred theme
theme_set(theme_bw())

# ----- plot dimensions
plotWidth <-  8 # width
plotHeight <- 4 # height

# ----- axis scaling
dpiset <- 125

# ----- file names and directory locations
fileEndings <- c('.png')            # c('.png', '.svg')
fileEnding <- '.png'
imageDir <- './graphs/'

# ----- recent graphs ...
recentDates = as.Date( c('1949-12-30',  '2006-12-30',   '2010-12-30') )
recentFileSuffix =     c('-from0000',  '-from2007',    '-from2011')

# ----- some other constants
#Grey is the British, Canadian, Australian, Irish,
#   New Zealand and South African spelling
s.thin <- 0.3
s.thick <- 0.8
c.trend <-   'red'
c.seasadj <- 'blue'
c.tty <- 'red'
c.ponp <- 'blue'
c.persons <- 'blueviolet'
c.males <-   'cornflowerblue'
c.females <- 'hotpink'
c.original <- 'purple'
genderTag <- c('Males', 'Females', 'Persons')

# ----- some quick and dirty functions ...
standardOpts <- function(plot)
{
    plot <- plot +
        opts(
            legend.position='bottom',
            legend.direction='horizontal',
            legend.title=theme_blank(),
            legend.key=theme_blank(),
            legend.text=theme_text(size=8)
        )
    return(plot)
}

selectiveOrigin <- function(p, rng)
{
    # if close to the origin - put in a line ...
    if (rng[1] <= 0.2 && rng[2] >= -0.2 &&
      abs(rng[2] - rng[1]) > 2 )
        p <- p + geom_hline(yintercept=0, colour='black',
            size=0.2, alpha=0.3)
    return (p)
}

loadFiles <- function(loadList=NULL, freq=NULL)
{
    # sanity checks ...
    if (is.null(loadList) || is.null(freq))
        stop('Missing variables in function loadFiles')
    if (length(loadList) < 2 )
        stop('not enough files in loadFiles')
    if (freq != 4 && freq != 12)
        stop('Unexpected frequency in function loadFiles')
    
    virgin <- TRUE
    while(length(loadList) > 0 )
    {
        sql <- paste('select * from ', loadList[1])
        loadList <- loadList[-1]    # drop the first one ...
        rs <- dbSendQuery(conn, sql)
        df <- fetch(rs, n = -1)
        df["endDate"] <- as.Date(as.yearmon(df[, 1]), frac=1)
        if (freq == 4)
            df["Date"] <- as.Date(as.yearqtr(df$endDate), frac=0.5)
        if (freq==12)
            df["Date"] <- as.Date(as.yearmon(df$endDate), frac=0.5)
  
        if (virgin)
        {
            theData <- df 
            virgin <- FALSE 
        }
        else
            theData <- merge(df, theData, by = "Date", all = TRUE)
        remove(df) # not really needed ...
    }
    return (theData)
}

addFootnote <- function(plot=NULL, footnote=NULL)
{
    # Assumption that there is free space to insert the footnote ...

if(is.null(plot))
        stop('No plot provided to addFootnote(plot, footnote)')
    
    if(!is.null(footnote))
        plot <- arrangeGrob(plot, 
            sub=textGrob(footnote, x=0.01, just="left", vjust=0, hjust=0, 
                gp=gpar(fontface="italic", fontsize=8)))

return(plot)
}

### Maths ---------------------------------------------------

calculatePercentGrowth <- function(v, freq)
{
    # sanity checks ...
    if(freq!=1 && freq!=4 && freq!=12)
    {
        print(paste('Issues with selected frequency: ',
            as.character(freq), sep=''))
        stop()
    }
    if(length(v) <= freq)
    {
        print('Issues with length of vector')
        stop()
    }

# the math ...
    previous <- c(rep(NA, freq), v)
    previous <-
        previous[-((length(previous)-freq+1):length(previous))]
    rv <- ((v / previous) - 1) * 100
    return(rv)
}

calculateDifference <- function(v, freq)
{
    # sanity checks ...
    if(freq!=1 && freq!=4 && freq!=12)
    {
        print(paste('Issues with selected frequency: ',
            as.character(freq), sep=''))
        stop()
    }
    if(length(v) <= freq)
    {
        print('Issues with length of vector')
        stop()
    }

# the math ...
    previous <- c(rep(NA, freq), v)
    previous <-
        previous[-((length(previous)-freq+1):length(previous))]
    rv <- v - previous
    return(rv)
}

### Charting -------------------------------------------------

chartPercentGrowthFromSingleSeries <- function(df=NULL,
    graphFrame=NULL, categoryName=NULL, headingText=NULL,
    yLabel=NULL, freq=NULL, saveLocPrefix=NULL, footnote=NULL)
{
    # NOTES:
    #   - df is the dataframe from which the data will be extracted.
    #       - Assumed the date field is called 'Date' and it
    #         is set to the midpoint of the period
    #   - the graphFrame is a dataframe with the same values
    #     as for chartSingleSeries(), but:
    #       - yLabel is ignored (however, the optional
    #         yLabel argument to this function can augment it)

if (is.null(df) || is.null(graphFrame) || is.null(categoryName) ||
        is.null(headingText) ||is.null(freq) || is.null(saveLocPrefix))
    {
        print('Missing variable')
        stop()
    }
    # Note: yLabel optional ...
    if (freq!=4 && freq!=12)
    {
        print(paste('Issues with selected frequency: ',
            as.character(freq), sep=''))
        stop()
    }
    graphFrame <- graphFrame[!is.na(graphFrame[, 'series']), ]
    if(nrow(graphFrame)==1)
    {
        print('Issues with number of rows in the graphFrame')
        return()
    }
    
    series.frame <- NULL
    
    # develop the graph frame and calculate growths
    for(row in seq(from=1, to=nrow(graphFrame), by=1))
    {
        # get vars from the graphFrame ...
        title <- paste(graphFrame[[row, 1]], sep='') 
        series <- paste(graphFrame[[row, 'series']], sep='')

# some naming conventions ...
        PonPpcg <- paste(series, '.PonP.percent.growth', sep='')
        TTYpcg <- paste(series, '.TTY.percent.growth', sep='')
        
        # calculate percent growth ...
        df[, PonPpcg] <- calculatePercentGrowth(df[, series], 1)
        df[, TTYpcg] <- calculatePercentGrowth(df[, series], freq)

# build a growth graphFrame ...
        series.frame <- rbind(series.frame,
            data.frame(title=title, periodOnPeriod=PonPpcg,
            tty=TTYpcg))
    }
    
    # call the growth charting functions ...
    chartPercentGrowth(df=df, graphFrame=series.frame,
        categoryName=categoryName, headingText=headingText,
        yLabel=yLabel, freq=freq, saveLocPrefix=saveLocPrefix,
        footnote=footnote )
}

chartSingleSeries <- function(df=NULL, graphFrame=NULL,
    headingText=NULL, chartType=NULL,
    saveLocPrefix=NULL, footnote=NULL)
{
    # Notes:
    #   - df is the dataframe from which the data will be extracted.
    #       - Assumed the date field is called 'Date' and
    #         it is set to the midpoint of the period
    #   - the graphFrame is a dataframe with three values
    #       - title - the text name of the series -
    #         used in the heading and in the saved file name
    #       - series - the data series
    #       - yLabel - the Y axis Label

# some sanity checks ...
    if (is.null(df) || is.null(graphFrame) || is.null(headingText) ||
        is.null(chartType) || is.null(saveLocPrefix))
    {
        print('Missing variable in function chartSingleSeries')
        stop()
    }
    graphFrame <- graphFrame[!is.na(graphFrame[, 'series']), ]
    if(nrow(graphFrame)<1)
    {
        print('Issues with number of rows in the graphFrame')
        return()
    }

for(row in seq(from=1, to=nrow(graphFrame), by=1))
    {
        # get vars from the model 
        title <- paste(graphFrame[row, 1], sep='') 
        series <- paste(graphFrame[row, 'series'], sep='') 
        yLabel <- paste(graphFrame[row, 'yLabel'], sep='')

for(i in seq(from=1, to=length(recentDates), by=1))
        { 
         d <- subset(df, Date > recentDates[i])
            d <- d[!is.na(d[, series]), ] # skip the rubbish
            if (nrow(d) < 2) next # skip empty sets
                        
            f <- paste(saveLocPrefix, chartType, '-', title,
                recentFileSuffix[i], fileEnding, sep='')
            t <- paste(headingText, ': ', title, sep='')
            p <- ggplot(data=d)
            
            if(chartType == 'bar')
                p <- p + geom_bar(mapping=aes_string(x='Date', y=series),
              stat='identity', position='dodge', width=1,
              colour="white", fill='blue', size=0.1)
            else if(chartType == 'step')
                p <- p + geom_step(mapping=aes_string(x='Date',
                    y=series), colour='red', size=s.thick)
            else
                p <- p + geom_line(mapping=aes_string(x='Date',
                    y=series), colour='red', size=s.thick)
                
            p <- p + xlab('') + ylab(yLabel) + opts(title=t)

# let's mark an origin ...
            if (chartType == 'bar')
                p <- selectiveOrigin(p, c(-1, 1))
            else
                p <- selectiveOrigin(p, range(d[, series], finite=TRUE))
            
            if(!is.null(footnote))
             p <- addFootnote(p, footnote)

ggsave(p, width=plotWidth, height=plotHeight, filename=f,
             dpi=dpiset)
        }
    }
}

chartSeasonalTrend <- function(df=NULL, graphFrame=NULL,
    headingText=NULL, yLabel=NULL,
    saveLocPrefix=NULL, footnote=NULL, transform=1)
{
    # Notes:
    #   - df is the dataframe from which the data will be extracted.
    #       - Assumed the date field is called 'Date' and
    #         it is set to the midpoint of the period
    #   - the graphFrame is a dataframe with three values
    #       - column 1 - the text name of the series - used in
    #         the heading and in the saved file name
    #       - SeasAdj - the Seasonally Adjusted data seriues
    #       - Trend - the Trend data series
    #   - headingText - 
    #   - yLabel - as it will appear - typically 'Pecent' or '$ Million'
    #   - saveLocPrefix - the prefix for the file save location
    #     (might be something like './graph/trend-')
    #   - transform - if set, the series are divided by the
    #     value of transform

# some sanity checks ...
    if (is.null(df) || is.null(graphFrame) || is.null(headingText) ||
        is.null(yLabel) || is.null(saveLocPrefix))
    {
        print('Missing variable in function chartSeasonalTrend')
        stop()
    }
    # transform is optional

graphFrame <- graphFrame[!is.na(graphFrame[, 'SeasAdj']), ]
    graphFrame <- graphFrame[!is.na(graphFrame[, 'Trend']), ]
    if(nrow(graphFrame)<1)
    {
        print('Issues with number of rows in the graphFrame')
        return()
    }

for(row in seq(from=1, to=nrow(graphFrame), by=1))
    {
        # get vars from the model 
        series <- paste(graphFrame[[row, 1]], sep='') 
        trend <- paste(graphFrame[[row, 'Trend']], sep='') 
        seasadj <- paste(graphFrame[[row, 'SeasAdj']], sep='') 
        
        if(!is.null(transform))
        {
            df[, trend] <- df[, trend] / transform
            df[, seasadj] <- df[, seasadj] / transform
        }

for(i in seq(from=1, to=length(recentDates), by=1))
        { 
         d <- subset(df, Date > recentDates[i])
            d <- d[!is.na(d[, seasadj]), ] # skip the rubbish
            if (nrow(d) < 3) next
                        
            fileName <- paste(saveLocPrefix, 'seasadj+trend-',
                series, recentFileSuffix[i], fileEnding, sep='')
            t <- paste(headingText, ': ', series, sep='')
            
            p <- ggplot(data=d) + 
             geom_line(mapping=aes_string(x='Date', y=trend),
                 colour = c.trend, size=s.thick) +
             geom_line(mapping=aes_string(x='Date', y=seasadj),
                 colour = c.seasadj, size=s.thin) +
             xlab('') +        ## xlab(NULL)
             ylab(paste(yLabel, ' (Trend=', c.trend, ', SA=',
                 c.seasadj, ')', sep='')) +
             opts(title=t)

# let's mark an origin ...
            tr <- range(d[, trend], finite=TRUE)
            sar <- range(d[, seasadj], finite=TRUE)
            if ((tr[1] <= 0 || sar[1] <= 0) && (tr[2] >= 0 || sar[2] >= 0))
                p <- selectiveOrigin( p, c(-1, 1) )

if(!is.null(footnote))
             p <- addFootnote(p, footnote)

ggsave(p, width=plotWidth, height=plotHeight, filename=fileName,
             dpi=dpiset)
        }
    }
}

chartPercentGrowth <- function(df=NULL, graphFrame=NULL,
    categoryName=NULL, headingText=NULL,
    yLabel=NULL, freq=NULL, saveLocPrefix=NULL, footnote=NULL)
{
    # Notes:
    #   - df is the dataframe from which the data will be extracted.
    #       - Assumed the date field is called 'Date'
    #   - the graphFrame is a dataframe with three values
    #       - column 1 - the text name - used in the heading
    #         and in the saved file name
    #       - periodOnPeriod - the month-on-month or
    #         quarter-on-quarter data series
    #       - tty - the through-the-year data series
    #   - categoryName is the category of series in the graphFrame
    #     (eg, sectors, states, etc.)
    #   - headingText
    #   - freq is number of periods in a year - ie 4=quaterly, 12=monthly
    #   - saveLocPrefix - the prefix for the file save location
    #     (might be something like './graph/trend-')
    
    # some sanity checks ...
    if (is.null(df) || is.null(graphFrame) || is.null(categoryName) ||
        is.null(headingText) ||is.null(freq) || is.null(saveLocPrefix))
    {
        print('Missing variable')
        stop()
    }
    # Note: yLabel optional ...
    if (freq!=4 && freq!=12)
    {
        print(paste('Issues with selected frequency: ',
            as.character(freq), sep=''))
        stop()
    }
    
    graphFrame <- graphFrame[!is.na(graphFrame[, 'periodOnPeriod']), ]
    if(nrow(graphFrame)<1)
    {
        print('Issues with number of rows in the graphFrame')
        return()
    }
    
    
    # set the growth period that will be reported
    periodic <- '***'
    if (freq==4) periodic <- 'Q/Q'
    if (freq==12) periodic <- 'M/M'

# make a space to remember summary outcomes
    graphFrame[ , 'tty.summary'] <- rep(NA, nrow(graphFrame))
    graphFrame[ , 'ponp.summary'] <- rep(NA, nrow(graphFrame))

toText <- NULL
    for (row in seq(from=1, to=nrow(graphFrame), by=1))
    {
        # get vars from the graph frame 
        series <- paste(graphFrame[[row, 1]], sep='') 
        ponp <- paste(graphFrame[[row, 'periodOnPeriod']], sep='') 
        tty <- paste(graphFrame[[row, 'tty']], sep='') 
        
        for (i in seq(from=1, to=length(recentDates), by=1))
        { 
         d <- subset(df, Date > recentDates[i])
            d <- d[!is.na(d[, ponp]), ]
            
            if (nrow(d) < 2)
            {
                print('Waring: bailing out')
                next    # check for empties
            }
            
            # capture the summary points ...
            if (i==1)
            {
                graphFrame[row, 'tty.summary'] <- d[nrow(d), tty]
                graphFrame[row, 'ponp.summary'] <- d[nrow(d), ponp]
                if(is.null(toText))
                {
                    lastDate <- d[nrow(d), 'Date']
                    if (freq==4) # Date is middle of quarter
                        lastDate <- lastDate + 31
                    toText <- as.character(lastDate, format="%b %Y")
                }
            }
            
            titleText <- paste('Growth in ', headingText, ': ',
                series, sep='')
            f <- paste(saveLocPrefix, 'percent-growth-',
                series,recentFileSuffix[i],fileEnding,sep='')
            
            percent <- 'Percent'
            if(!is.null(yLabel))
                percent <- paste(percent, ' ', yLabel, sep='')
                         
         p <- ggplot(data=d) + 
          geom_bar(mapping=aes_string(x='Date', y=ponp),
              stat='identity', position='dodge', width=1,
              colour="white", fill=c.ponp, size=0.1) +
             geom_line(mapping=aes_string(x='Date', y=tty),
                 colour=c.tty, size=s.thick) + 
             xlab('') +  ## xlab(NULL)
             ylab(paste(percent,' (',periodic,'=',
                 c.ponp,' TTY=',c.tty,')',sep='')) +
             opts(title = titleText) +
             geom_hline(yintercept=0, colour='black',
                 size=0.2, alpha=0.3)
             
            if(!is.null(footnote))
             p <- addFootnote(p, footnote)

ggsave(p, width=plotWidth, height=plotHeight, filename=f,
             dpi=dpiset)
        }
    }
    
    
    if(nrow(graphFrame) > 1)
    {
        # let's drop some summary charts ...
        id <- colnames(graphFrame)[1]
        
        # TTY Growth
        molten <- melt(graphFrame, id.var=id, measure.var='tty.summary')
        colnames(molten)[1] <- categoryName
        molten <- molten[!is.na(molten$value), ]    
        molten <- molten[with(molten, order(-value)), ]  
        molten[, categoryName] <- ordered(molten[, categoryName],
            levels=levels(molten[, categoryName])[unclass(
            molten[, categoryName])])
        
        t <- paste('TTY Growth in ', headingText, ' to ',
            toText, sep='')
        f <- paste(saveLocPrefix, '!summary-percent-growth-tty-',
            categoryName,fileEnding,sep='')
        
        p <- ggplot(molten, aes_string(x=categoryName, y='value')) + 
            geom_bar(position="dodge", stat="identity", colour="white",
                fill='grey50', size=0.2) +
            coord_flip() +
            opts(title=t) +
            ylab('Percent')
        if(!is.null(footnote))
            p <- addFootnote(p, footnote)
        ggsave(p, width=plotWidth, height=plotHeight, filename=f,
            dpi=dpiset)
    
        # Period on Period Growth ...
        molten <- melt(graphFrame, id.var=id, measure.var='ponp.summary')
        colnames(molten)[1] <- categoryName
        molten <- molten[!is.na(molten$value), ]   
        molten <- molten[with(molten, order(-value)), ]  
        molten[, categoryName] <- ordered(molten[, categoryName],
            levels=levels(molten[, categoryName])[
            unclass(molten[, categoryName])])
        
        t <- paste(periodic, ' Growth in ', headingText, ' to ',
            toText, sep='')
        f <- paste(saveLocPrefix, '!summary-percent-growth-ponp-',
            categoryName,fileEnding,sep='')
        p <- ggplot(molten, aes_string(x=categoryName, y='value')) + 
            geom_bar(position="dodge", stat="identity",
                colour="white", fill='grey50', size=0.2) +
            coord_flip() +
            opts(title=t) +
            ylab('Percent')
        if(!is.null(footnote))
            p <- addFootnote(p, footnote)
        ggsave(p, width=plotWidth, height=plotHeight, filename=f,
            dpi=dpiset)
        
        #plot tty comparison
        f <- paste(saveLocPrefix, '!summary-comparative-tty-',
            categoryName,sep='')
        t <- paste('TTY Growth for ', headingText, ' by ',
            categoryName, sep='')
        frame <- data.frame(breaks=as.vector(graphFrame$tty),
            labels=as.vector(graphFrame[, 1]))
        chartMultiLine(df=df, graphFrame=frame, heading=t,
            yLabel='Percent', saveLocPrefix=f, footnote=footnote)
    }
}

chartMultiLine <- function(df=NULL, graphFrame=NULL,
    heading=NULL, yLabel=NULL,
    saveLocPrefix=NULL, footnote=NULL,
    lineTypeThreshold=5)
{
    # --- sanity checks
    if (nrow(graphFrame) > 12)
    {
        print('chartMultiLine(): Too many lines')
        return(FALSE)
    }

# --- the graphFrame ...
    breaks <- as.vector(graphFrame$breaks)
    bPlus <- c('Date', breaks)
    labels <- as.vector(graphFrame$labels) 
    lPlus <- c('Date', labels)
    
    df<- df[, bPlus]
    colnames(df) <- lPlus
    molten <- melt(df, id.vars='Date', measure.vars=labels)
    molten <- molten[!is.na(molten$value), ]
    
    for(i in seq(from=1, to=length(recentDates), by=1))
    {
        m <- subset(molten, Date > recentDates[i])
        if(nrow(m) < 2) next
            
        f <- paste(saveLocPrefix, recentFileSuffix[i],
            fileEnding, sep='')
     p <- ggplot(data=m)

if(length(breaks) >= lineTypeThreshold)
         p <- p + geom_line(aes_string(x='Date', y='value',
             group='variable', colour='variable', lty='variable'),
             size=0.8)
     else
         p <- p + geom_line(aes_string(x='Date', y='value',
             group='variable', colour='variable'), size=0.8)
     
     p <- p + xlab(NULL) + ylab(yLabel) + opts(title=heading)
     p <- selectiveOrigin(p, range(m$value, finite=TRUE))
     p <- standardOpts(p)
        if(!is.null(footnote))
         p <- addFootnote(p, footnote)
     
     ggsave(p, width=plotWidth, height=plotHeight, filename=f,
         dpi=dpiset)
 }
}

chartPercentGrowthFromSeasonalTrend <- function(df, graphFrame,
    categoryName, headingText, freq,
    saveLocPrefix, footnote=NULL)
{
    # Notes:
    #   - df is the dataframe from which the data will be extracted.
    #       - Assumed the date field is called 'Date' and that it
    #         is the midpoint of the period
    #   - the graphFrame is a dataframe with three values
    #       - column 1 - the text name of the series - used in the
    #         heading and in the saved file name
    #       - SeasAdj - the Seasonally Adjusted data seriues
    #       - Trend - the Trend data series
    #   - freq - number of periods in a year - ie 4=quaterly, 12=monthly
    #   - saveLocPrefix - the prefix for the file save location 
    #     might be something like './graph/trend-')

# some sanity checks on frequency of data per year ...
    if(freq!=4 && freq!=12)
    {
        print(paste('Issues with selected frequency: ',
            as.character(freq), sep=''))
        stop()
    }
    graphFrame <- graphFrame[!is.na(graphFrame[, 'SeasAdj']), ]
    graphFrame <- graphFrame[!is.na(graphFrame[, 'Trend']), ]
    if(nrow(graphFrame)<1)
    {
        print('Issues with number of rows in the graphFrame')
        return()
    }
    
    trends.frame <- NULL
    seasadjs.frame <- NULL
    
    # develop the graph frame and calculate growths
    for(row in seq(from=1, to=nrow(graphFrame), by=1))
    {
        # get vars from the graphFrame ...
        series <- paste(graphFrame[[row, 1]], sep='') 
        trend <- paste(graphFrame[[row, 'Trend']], sep='')
        seasadj <- paste(graphFrame[[row, 'SeasAdj']], sep='')

# some naming conventions ...
        trendPonPpcg <- paste(trend, '.PonP.percent.growth', sep='')
        trendTTYpcg <- paste(trend, '.TTY.percent.growth', sep='')
        seasadjPonPpcg <- paste(seasadj, '.PonP.percent.growth', sep='')
        seasadjTTYpcg <- paste(seasadj, '.TTY.percent.growth', sep='')
        
        # calculate percent growth ...
        df[, trendPonPpcg] <- calculatePercentGrowth(df[, trend], 1)
        df[, seasadjPonPpcg] <- calculatePercentGrowth(df[, seasadj], 1)
        df[, trendTTYpcg] <- calculatePercentGrowth(df[, trend], freq)
        df[, seasadjTTYpcg] <- calculatePercentGrowth(df[, seasadj], freq)

# build a growth graphFrame ...
        trends.frame <- rbind(trends.frame,
            data.frame(series=series, periodOnPeriod=trendPonPpcg,
            tty=trendTTYpcg))
        seasadjs.frame <- rbind(seasadjs.frame,
            data.frame(series=series, periodOnPeriod=seasadjPonPpcg,
            tty=seasadjTTYpcg))
    }
    
    # call the growth charting functions ...
    chartPercentGrowth(df=df, graphFrame=trends.frame,
        categoryName=categoryName,
        headingText=paste(headingText,' (Trend)',sep=''),
        freq=freq, saveLocPrefix=paste(saveLocPrefix,'trend-',sep=''),
        footnote=footnote)

chartPercentGrowth(df=df, graphFrame=seasadjs.frame,
        categoryName=categoryName,
        headingText=paste(headingText,' (SeasAdj)',sep=''),
        freq=freq, saveLocPrefix=paste(saveLocPrefix,'sa-',sep=''),
        footnote=footnote)
}

The program I wrote to produce the slides for this animation is an example of how I link these together ...

### r-industry-anime.R
###
###     GNU R batch file for plotting graphs
###

### --- initialisation ...
source("../bin/mysqlConnect.R")
source('../bin/i-plot-constants.R')
library('zoo')

# --- localised kludge ...
# because Google's blogger doesn't like large 
# files we will reduce the size of the plot
# from 1000x500 to 640x320
dpiset <- 80

### ---  load the data ...
rs <- dbSendQuery(conn,
    "select * from TT_5206006_industry_gva_Data1") 
industry <- fetch(rs, n = -1)
industry$endDate <- as.Date(as.yearmon(industry[, 1]), frac=1.0)
industry$Date <- as.Date(as.yearqtr(industry$endDate), frac=0.5)
industry <- subset(industry, Date > as.Date('1974-07-01'))

frame <- read.csv('!industry.csv')

### - for each row in the dataset, drop a plot ...

# - constants ...
title <- 'Australian Economy by Size of Industry Sector'
imageDir <- paste(imageDir,'!anime-',sep='')

for ( ind in 1:nrow(industry) )
{
    # - calculate the percentage proportions ...
    result <- rep(NA, nrow(frame))
    for ( i in 1:nrow(frame) )
    {
        numerator <- industry[ind, paste(frame[i, 'Trend'],sep='')]
        # A2303599W ==> Gross value added at basic prices 
        denominator <- industry[ind, 'A2303599W'] 
        result[i] <- numerator / denominator * 100
    }
    frame$result <- result
    
    # - do the plot ...
    fileName <- paste(imageDir, sprintf('%3.3d', ind), '.png', sep='')
    toText <- as.character(industry[ind, 'endDate'], format="%Y %b")
    molten <- melt(frame, id.var='Series', measure.var='result')
    p <- ggplot(molten, aes_string(x='Series', y='value')) + 
        geom_bar(position="dodge", stat="identity", colour="white",
            fill='grey50', size=0.2) +
        coord_flip() +
        scale_y_continuous(limits=c(0,19), breaks=0:19, labels=0:19) +
        opts(title=title) +
        ylab('Percent')
    p <- addFootnote(p, toText)
    ggsave(p, width=plotWidth, height=plotHeight, filename=fileName,
        dpi=dpiset)
}

### --- tidy up when done
dbDisconnect(conn)

You will notice that it accesses a CSV file to select the series to chart. That CSV file is as follows. The Trend and Seasonally Adjusted items are the series identifiers used by the ABS. I use these same identifiers to keep the data items in the MySQL database.

Mark the Graph

Sunday, June 10

Some of my charting programs

No comments:

Post a Comment