I got basic functionality down, but want to continue to add things to the function. call ggChartSeries() and provide an OHLC object from quantmod, along with start and end dates in as.Date() form. It calculates moving averages and after that trims the data series, as opposed to chartSeries(), which has issues with this since it takes the pre-trimmed data as an input.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

require(quantmod)
require(ggplot2)
 
getSymbols('AAPL')
x<-AAPL
start <- Sys.Date()-200
end <- Sys.Date()
 
#Pass an OHLC object into this function
#also pass two dates formatted as.Date()
ggChartSeries <- function(x, start, end){
 
# the below is done redundantly for ease of maintenance later on
#First, strip OHLC data (need to vectorize)
  date <- as.Date(time(x))
  open <- as.vector(Op(x))
  high <- as.vector(Hi(x))
  low <- as.vector(Lo(x))
  close <- as.vector(Cl(x))
 
#Then build the data frame
  xSubset <-data.frame('date'=date,'open'=open,'high'= high,'low'=low,'close'=close)
 
#We want to construct our candlesticks  
  xSubset$candleLower <- pmin(xSubset$open, xSubset$close)
  xSubset$candleMiddle <- NA
  xSubset$candleUpper <- pmax(xSubset$open, xSubset$close)
  xSubset$fill <- ''
  xSubset$fill[xSubset$open < xSubset$close] = 'white'
  xSubset$fill[xSubset$fill ==''] = 'red'
 
#Add Moving Averages
  xSubset$ma200 <- SMA(xSubset$close, 200)
  xSubset$ma50 <- SMA(xSubset$close, 50)
 
#Trim Data
  xSubset <-subset(xSubset, xSubset$date > start & xSubset$date < end)
 
#Graphing Step
  g <- ggplot(xSubset, aes(x=date, lower=candleLower, middle=candleMiddle, upper=candleUpper, ymin=low, ymax=high)) 
  g <- g + geom_boxplot(stat='identity', aes(group=date, fill=fill))
  g <- g + geom_line(aes(x=date, y=ma50))+ geom_line(aes(x=date, y=ma200))
  g 
}
 
#call our graphing function
ggChartSeries(AAPL, start, end)

Todo list:

• Add titles and labeling
• Add more TA indicators
• Tweak colors
• Add/refine options to the function
• Add volume bars at the bottom

The key to doing this is using both order() and with(). Order returns the ID numbers of how the vector should look. With allows you to rewrite a new data frame.

My code ended up looking like this:

country.trim <- country.trim[with(country.trim, order(-income)),]

I started with my original variable country.trim which was a dataframe containing variables country, income, and debt. I desired to sort the countries by income in descending order. So what we do is sort of "play back" the existing dataframe into its sorted form. with() country.trim, we take the order(). order() will only sort in ascending order, so we make income negative. order() gives us a vector of what the new row names should be, and we play that back into the new country.trim variable.

In the more general case, this is what you want to do:

dataFrame.sorted <- dataFrame.original[ with(dataFrame.original, order(sortCriteria1, sortCriteria2,....)) , ]

Do this where each sortCriteria is one of the members of the data frame. For example, in the example of my code, I don't use order(-country$income). You can have as many sort criteria as you want, and remember to prepend a minus sign to any variables that should be sorted in descending order.

Convergence for the calculation of A-S Riskiness for weekly AAPL returns

Since we know exactly the value we are trying to reach and the parameters of the output, I figured we could converge on the solution from both sides and arrive at the solution much more quickly.

Thus, I redesigned the algorithm to bounce back and forth between max and min values, dividing by half for each iteration. Here is the source code for my redesigned version of asRisk(). As always, feed it a vector of possible returns.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

#This function bounces back and forth to find asRisk much quicker
#Feed me a vector of returns
asRisk <- function(x){
  #If there are no negative bets and negative expected value, then return 0
  if (mean(x)<0|min(x)>=0){
    return(0)
  } else {
    #first let's use e as our first guess
    asNumber <- exp(1)
    total <- sum((1/length(x))*exp(-x/asNumber))
    #If the number is too low, we will try to find a min limit
    if (total < 1){
      max <- asNumber
      while (total < 1){
        asNumber <- asNumber / 10
        total <- sum((1/length(x))*exp(-x/asNumber))
      }
      #we found the max, so set the min
      min <- asNumber
    } else if (total > 1){
      min <- asNumber
      while (total > 1){
        asNumber <- asNumber * 10
        total <- sum((1/length(x))*exp(-x/asNumber))
      }
      #we found the min, so set the max
      max <- asNumber
    }
    #Precision is adjustable
    #We will do until difference between max/min 
    #is within tolerance.
    while ((max-min)>0.000000001){
      asNumber <- (max+min)/2
      total <- sum((1/length(x))*exp(-x/asNumber))
      if(total > 1){
        min <- asNumber
      } else if (total < 1){
        max <- asNumber
      }
    }
 
 
    return(sprintf("%.6f",asNumber))
 
  }
}

You can fiddle around with the code to adjust the precision, but I am currently very happy with the speed/precision tradeoff at the moment. This new function quickly calculates very precise Aumann-Serrano riskiness, as verified by my older function. I have yet to include warnings though. If the problem of out of bounds, I merely return "0" rather than throwing an error.

Bonus: The code to produce the graph pictured above

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

library(quantmod)
library(ggplot2)
 
getSymbols("AAPL")
x<-weeklyReturn(AAPL)
count<-1
minV <- 1:100
maxV <- 1:100
 
if (mean(x)<0|min(x)>=0){
  return(0)
} else {
  asNumber <- exp(1)
  total <- sum((1/length(x))*exp(-x/asNumber))
  count <- count + 1
  if (total < 1){
    max <- asNumber
    maxV[count] <-asNumber
    while (total < 1){
      asNumber <- asNumber / 10
      total <- sum((1/length(x))*exp(-x/asNumber))
      count <-count + 1
    }
    #we found the max, so set the min
    min <- asNumber
    minV[count] <- asNumber
  } else if (total > 1){
    min <- asNumber
    minV[count] <- asNumber
    while (total > 1){
      asNumber <- asNumber * 10
      total <- sum((1/length(x))*exp(-x/asNumber))
      count <- count + 1
    }
    #we found the min, so set the max
    max <- asNumber
    maxV[count] <- asNumber
  }
  #Precision is adjustable
  #We will do until difference between max/min 
  #is within tolerance.
  while ((max-min)>0.000000001){
    asNumber <- (max+min)/2
    total <- sum((1/length(x))*exp(-x/asNumber))
    count <- count + 1
    if(total > 1){
      min <- asNumber
      minV[count] <- asNumber
    } else if (total < 1){
      max <- asNumber
      maxV[count] <- asNumber
    }
  }
}
 
#trim output and put it into data fram output
minV <- subset(minV, (minV %% 1)!=0)
maxV <- subset(maxV, (maxV %% 1)!=0)
if(length(minV)<length(maxV)){
  count <- length(minV)
} else {
  count <- length(maxV)
}
output <- data.frame(count=c(1:count),min=minV[1:count], max=maxV[1:count])
 
#let's graph
g <- ggplot(output, aes(count, min))
g <- g + geom_point() + geom_point(aes(count,max))
g <- g+ geom_ribbon(aes(x=count, ymin=min, ymax=max), alpha=.4)
g <- g + opts(title='Convergence')+ scale_x_continuous('Repetitions')+scale_y_continuous('Max and Min')
g 
ggsave("file.png")

Data:

-Inequality data available from Saez's website: Data updated through 2008 (.xls)  Look for the sheet "data-Fig2" for the top 1% income including capital gains from 1913-2008
-Recession data from FRED using code USREC, although a list that can be copy-pasted into R/SAS is available at the FRED FAQ page

The inspiration for this graph comes from a post about using R+ggplot to show recession bars and silver prices.  I thought the addition of recession bars and elimination of chartjunk would be nice.

Code is here, it includes all the data in a self contained package and will output a nice anti-aliased PNG using ggsave:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158

#load dependencies
require(ggplot2)
 
 
#grab recession data and put it into a dataframe recessions.df
recessions.df = read.table(textConnection(
  "Peak, Trough
1857-06-01, 1858-12-01
  1860-10-01, 1861-06-01
  1865-04-01, 1867-12-01
  1869-06-01, 1870-12-01
  1873-10-01, 1879-03-01
  1882-03-01, 1885-05-01
  1887-03-01, 1888-04-01
  1890-07-01, 1891-05-01
  1893-01-01, 1894-06-01
  1895-12-01, 1897-06-01
  1899-06-01, 1900-12-01
  1902-09-01, 1904-08-01
  1907-05-01, 1908-06-01
  1910-01-01, 1912-01-01
  1913-01-01, 1914-12-01
  1918-08-01, 1919-03-01
  1920-01-01, 1921-07-01
  1923-05-01, 1924-07-01
  1926-10-01, 1927-11-01
  1929-08-01, 1933-03-01
  1937-05-01, 1938-06-01
  1945-02-01, 1945-10-01
  1948-11-01, 1949-10-01
  1953-07-01, 1954-05-01
  1957-08-01, 1958-04-01
  1960-04-01, 1961-02-01
  1969-12-01, 1970-11-01
  1973-11-01, 1975-03-01
  1980-01-01, 1980-07-01
  1981-07-01, 1982-11-01
  1990-07-01, 1991-03-01
  2001-03-01, 2001-11-01
  2007-12-01, 2009-06-01"), sep=',',
colClasses=c('Date', 'Date'), header=TRUE)
 
#grab inequality data and put it into a dataframe inequality.df
inequality.df = read.table(textConnection(
  "year,percent
1913,0.18
1914,0.182
1915,0.176
1916,0.193
1917,0.177
1918,0.16
1919,0.164
1920,0.148
1921,0.156
1922,0.171
1923,0.156
1924,0.174
1925,0.202
1926,0.199
1927,0.21
1928,0.239
1929,0.224
1930,0.172
1931,0.155
1932,0.156
1933,0.165
1934,0.164
1935,0.167
1936,0.193
1937,0.171
1938,0.158
1939,0.162
1940,0.165
1941,0.158
1942,0.134
1943,0.123
1944,0.113
1945,0.125
1946,0.133
1947,0.12
1948,0.122
1949,0.117
1950,0.128
1951,0.118
1952,0.108
1953,0.099
1954,0.108
1955,0.111
1956,0.107
1957,0.102
1958,0.102
1959,0.106
1960,0.1
1961,0.106
1962,0.099
1963,0.099
1964,0.105
1965,0.109
1966,0.102
1967,0.107
1968,0.112
1969,0.104
1970,0.09
1971,0.094
1972,0.096
1973,0.092
1974,0.091
1975,0.089
1976,0.089
1977,0.09
1978,0.09
1979,0.1
1980,0.1
1981,0.1
1982,0.108
1983,0.116
1984,0.12
1985,0.127
1986,0.159
1987,0.127
1988,0.155
1989,0.145
1990,0.143
1991,0.134
1992,0.147
1993,0.142
1994,0.142
1995,0.152
1996,0.167
1997,0.18
1998,0.191
1999,0.2
2000,0.215
2001,0.182
2002,0.169
2003,0.175
2004,0.198
2005,0.219
2006,0.228
2007,0.235
2008,0.209"), sep=',', colClasses=c('numeric', 'numeric'), header=TRUE)
 
#trim recessions to meet minimum date of data
recessions.trim <- subset(recessions.df, format(Peak,format="%Y") >= min(inequality.df$year))
 
#build a ggplot object with the inequality data, Note: X axis is "date", not "continuous
g <- ggplot(inequality.df) + geom_line(aes(x=as.Date(strptime(year, format = "%Y")), y=percent)) +theme_grey()
g <- g + scale_x_date('Year',format="%Y", major="5 years", minor="1 year")
g <- g + scale_y_continuous('Percent of total income',formatter='percent')
 
#add recession boxes
g = g + geom_rect(data=recessions.trim, aes(xmin=Peak, xmax=Trough, ymin=-Inf, ymax=+Inf), fill='blue', alpha=0.2)
 
#add title
g <- g+ opts(title="Income share of top 1%\n1913-2008")
#print graph
g
ggsave(file='output.png')

Some lessons learned from this project mainly involve the grammar of ggplot2, but more importantly how to use data types and axis scaling. Originally, I did this graph at 6am on Friday morning. As a shortcut, I simply collapsed recession data into yearly data so that I had two vectors with numeric data. In this more well-thought-out version, I use scale_x_date() instead of scale_x_continuous(). This allowed me to control axis formatting better, at the expense of requiring me to figure out how to convert both %Y and %Y-%M dates to POSIX dates using strptime(year, format = "%Y"). as.Date() and other functions would not allow a date without month/day.

In the end, instead of fussing with PNG graphics devices, which lack anti-aliasing under Windows, I used ggplot's built-in function ggsave(), and was very happy with the result:

Final graph of income share of the top 1% with recession bars

1
2
3
4
5
6
7
8
9
10
11
12
13

asRisk <- function(x){
  if (mean(x)<0|min(x)>=0){
    return(0) #If expected value is  < 0 or there are no negatives, return 0
  } else {
      asNumber <- 0.00001
      total <- 2
      while (total > 1){
        total <- sum((1/length(x))*exp(-x/asNumber))
        asNumber <- asNumber + .00001
      }
      return(sprintf("%.5f",asNumber))
  }
}

To use this function, input a vector of returns. If AS risk cannot be calculated, the function will return "0". If the gambles can be used, it will calculate AS riskiness to 5 decimal points. If more or less are desired, you can change

Generally, to use this, I would recommend using one of the functions in quantmod such as weeklyReturn() or dailyReturn(). An example of this would be

1

asRisk(dailyReturn(AAPL['2010']))

This example will return the AS risk of AAPL stock in 2010. Quantmod uses the TTR package which allows a lot of quick and powerful date selection.

In the future I will add errors/warnings, and maybe make precision adjustable or switch to a solver package. I also need to revise the function to meet a few more of my design parameters. This seems to be a good start and perfect for my research project next semester though!

AS Riskiness supposes for each gamble $g$, there exists a unique positive number $R(g)$ that satisfies ${\rm{E}}{e^{ - g/R(g)}} = 1$

There are a few conditions though:

• Gambles must have a positive expected value (you can't use it at Vegas)
• Gambles must include one negative outcome (you must have skin in the game)

In exchange for these restrictions, one gets a measure of risk that is strictly monotone with respect to stochastic dominance. Additionally, a paper in 2011 by Homm and Pigorsch (link) established an economic performance measurement similar to the Sharpe Ratio, but one that excels at situations in which returns are not normally distributed (such as the 2008 GFC). In my classes, I did an initial exploration of the relation of returns and AS riskiness and found that the tendency of AS riskiness to rapidly respond to losses does have advantages for risk-conscious investors. See the shape of AS risk vs. Return below:

SP500 Component AS Risk vs Return for 2010

For future investigation, I want to have an R function that calculates AS riskiness, so my prototype is as follows:

-Name: asRisk()
-Input: vector of returns in percent
     -This makes it easy to use the function with quantmod
     -Also more versatile
-Dependencies/Requirements: none
     -One possible way to solve for AS risk is to use an R package with a solver, such as ROI
     -I would rather not have any dependencies, as my need for precision isn't very high
-Precision: 1/1000
-Method: Iterative from 0.0001 to 1000
     -The program will give up at 1000, as the function goes out to infinity as returns approach zero
     -In most cases, our risk scores are much much lower, so any sane situation should have no problem with this
     -If this method is too slow on modern computers (unlikely), I will consider moving to a solver package
-Error Checking: We will check for
     -Negative overall return (return Error)
     -No negative outcomes (return Error)
     -Failed sanity check, AS Score > 1000 (return Warning)
-Output: AS risk score

This will be my first R function other than "Hello, World!", so I am going to try to keep the solution as simple as possible.  Once I have a solid foundation with my current solver, I will attempt to work towards using option chains to counteract the negative overall return error, and potentially to use a solver.  The simple version will be a large improvement over Excel though, with its floating point errors that are a huge source of errors with large numbers of observations.

When doing research in foreign equities, I always use quantmod and R to get quotes. Google does not usually support CSV downloads of foreign quotes, but in most every case, Yahoo does. The "getSymbols()" function in quantmod is fully equipped for this, except for one crucial problem: foreign exchanges often use numbers rather than alphabetical identifiers for ticker symbols, especially in Asia. Examples of this are HTC in Taiwan(2498.TW), NCSoft in Korea (036570.KS), and Ping An in Hong Kong (2318.HK).

This nomenclature has obvious implications for computer languages which will generally disallow variable names that begin with numbers. In R, this is also the case, and quantmod will attempt to create a dataframe with the name of the ticker symbol. This problem took a while for me to discover, since quantmod will not give you an error when you try to retrieve the quote. For instance, let me try to retrieve Apple (AAPL):
> getSymbols("AAPL", src = "yahoo")
[1] "AAPL"

I enter the command "getSymbols()" and when R has finished downloading the data, it echos the name of the dataframe created "AAPL".  Let's try HTC (2498.TW) now:
> getSymbols("2498.tw", src = "yahoo")
[1] "2498.TW"

It would appear as though the data has been downloaded correctly, and if you have automated this process, you wouldn't know the problem.  The only way the problem will present is as a frustrating error:
> length(AAPL)
[1] 4536
> length(2498.TW)
Error: unexpected symbol in "length(2498.TW"

The fix for the problem is very simple or very difficult, depending on your situation.  The solution to the problem is to set "auto.assign=FALSE" when calling getSymbols(). This will allow you to assign the data returned to a variable name of your choice. For example:
> HTC.TW <- getSymbols("2498.TW", src = "yahoo", auto.assign=FALSE)

This code will not echo like the previous examples, since you are explicitly naming the variable yourself.  As I mentioned before, the solution is either simple or complex.  If one were running a long script with many equities from different countries, the lack of errors might cause big problems.  Correcting the names on a large scale would likely rely on using regular expressions or a predefined list of alternate ticker symbols combined with the technique listed above.

To find the cost of equity, I use CAPM, which states

$E(R_i) = R_f + \beta_{i}(E(R_m) - R_f)\,$

where $E(R_i)$ is the expected return on capital, after accounting for the market risk premium.  To find the component pieces  $R_f$,   $R_m$, and $\beta_{i}$, I will use R with the quantmod package, and I will also use the PerformanceAnalytics Package, although I will show you how to avoid using it if you choose.

The sourcecode for the project:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

#Packages required
require(PerformanceAnalytics)
require(quantmod)
require(car)
 
#Here we get the symbols for the SP500 (GSPC), AAPL, and 5yr Treasuries (GS5)
getSymbols("^GSPC", src = "yahoo", from = as.Date("2008-01-01"), to = as.Date("2011-12-31"))
getSymbols("AAPL", src = "yahoo", from = as.Date("2009-01-01"), to = as.Date("2011-12-31"))
getSymbols("GS5", src = "FRED", from = as.Date("2008-12-01"), to = as.Date("2011-12-31"))
 
#Market risk R_m is the arithmetic mean of SP500 from 2009 through 2011
#Riskfree rate is arithmetic mean of 5yr treasuries
marketRisk<- mean(yearlyReturn(GSPC['2009::2011']))
riskFree <- mean(GS5['2009::2011'])
 
#My professor advised us to use weekly returns taken on wednesday
#so I take a subset of wednesdays and use the quantmod function
#weeklyReturn()
AAPL.weekly <- subset(AAPL,weekdays(time(AAPL))=='Wednesday')
AAPL.weekly <- weeklyReturn(AAPL['2009::2011'])
GSPC.weekly <- subset(GSPC,weekdays(time(GSPC))=='Wednesday')
GSPC.weekly <- weeklyReturn(GSPC['2009::2011'])
 
#Here I use PerformanceAnalytics functions for alpha+beta
#Then we calculate Cost of equity using our calculated figures
AAPL.beta <- CAPM.beta(AAPL.weekly,GSPC.weekly)
AAPL.alpha <- CAPM.alpha(AAPL.weekly,GSPC.weekly)
AAPL.expectedReturn <- riskFree + AAPL.beta * (marketRisk-riskFree)
 
#For my graph, I want to show R^2, so we get it from the
#lm object AAPL.reg
AAPL.reg<-lm(AAPL.weekly~GSPC.weekly)
AAPL.rsquared<-summary(AAPL.reg)$r.squared
 
#Lastly, we graph the returns and fit line, along with info
scatterplot(100*as.vector(GSPC.weekly),100*as.vector(AAPL.weekly), smooth=FALSE, main='Apple Inc. vs. S&P 500 2009-2011',xlab='S&P500 Returns', ylab='Apple Returns',boxplots=FALSE)
text(5,-10,paste('y = ',signif(AAPL.alpha,digits=4),' + ',signif(AAPL.beta,digits=5),'x \n R^2 = ',signif(AAPL.rsquared,digits=6),'\nn=',length(as.vector(AAPL.weekly)),sep=''),font=2)

The code is commented, but I will make some additional comments on specific sections to explain the process for those unsure. I apologize for my unstandardized variable names as well!

First of all, I use the getQuotes() function, which has a few sources. In this example, I use Yahoo data for equity data and FRED for information on 5yr Treasuries. For reference, the ticker for retrieving the SP500 on Yahoo is "^GSPC", and the FRED code for 5yr treasuries is "GS5". Other symbols should be self explanatory.

Next is the issue of regression parameters. To find alpha and beta, I use the capm functions of PerformanceAnalytics, but to find $R^2$ I read it out of the the regression object using

1
2

AAPL.reg <- lm(AAPL.weekly~GSPC.weekly)
AAPL.rsquared <- summary(AAPL.reg)$r.squared

It is possible to do this with beta and alpha, however, I did not do this because I did not originally did not start out to find $R^2$, and turned to PerformanceAnalytics out of convenience.

Finally, I graphed the results and regression line for the benefit of my teacher, the results of which can be seen here:

S&P500 vs. Apple, 2009-2011