R version 3.3.0 (2016-05-03) -- "Supposedly Educational"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

[Workspace loaded from ~/.RData]

 install.packages("quantmod")
 library("quantmod")

 install.packages("rpart")
 library("rpart")

 install.packages("rpart.plot")
 library("rpart.plot")

 startDate = as.Date("2012-01-01")

 endDate = as.Date("2014-01-01")

 getSymbols("BAC", env = .GlobalEnv, src = "yahoo", from = startDate, to = endDate)

 relativeStrengthIndex3<-RSI(Op(BAC), n= 3)

 relativeStrengthIndex3

 exponentialMovingAverage5<-EMA(Op(BAC),n=5)

 exponentialMovingAverage5

 dim(exponentialMovingAverage5)

 str(exponentialMovingAverage5)

 exponentialMovingAverageDiff<- Op(BAC)-exponentialMovingAverage5

 exponentialMovingAverageDiff

 MACD<-MACD(Op(BAC),fast = 12, slow = 26, signal = 9)

 MACD

 head(MACD)

 MACDsignal<-MACD[,2]

 MACDsignal

 stochasticOscillator <- SMI(Op(BAC),n=13,slow=25,fast=2,signal=9)

 stochasticOscillator

 stochasticOscillatorSignal <- stochasticOscillator[,1]

 stochasticOscillatorSignal

 PriceChange <- Cl(BAC) - Op(BAC)

 PriceChange

 binaryClassification <- ifelse(PriceChange>0,"UP","DOWN")

 binaryClassification

 str(binaryClassification)

 DataSet<-data.frame(relativeStrengthIndex3, exponentialMovingAverageDiff, MACDsignal, stochasticOscillator, binaryClassification)

 DataSet

 head(DataSet)

 str(DataSet)

 colnames(DataSet) <- c("relativeStrengthIndex3", "exponentialMovingAverageDiff", "MACDsignal", "stochasticOscillator", "binaryClassification")

 colnames(DataSet)

 DataSet<-DataSet[-c(1:33),]

 DataSet

 head(DataSet)

 str(DataSet)

 dim(DataSet)

 TrainingDataSet <- DataSet[1:312,]
 TrainingDataSet

 str(TrainingDataSet)

 TestDataSet <- DataSet[313:469,]

 TestDataSet

 str(TestDataSet)

 DecisionTree<-rpart(binaryClassification~relativeStrengthIndex3+exponentialMovingAverageDiff+MACDsignal+stochasticOscillator,data=TrainingDataSet, cp=.001)

 prp(DecisionTree,type=2)

 printcp(DecisionTree)

 plotcp(DecisionTree,upper="splits")

 PrunedDecisionTree<-prune(DecisionTree,cp=0.041428)

 prp(PrunedDecisionTree, type=4)

 table(predict(PrunedDecisionTree,TestDataSet),TestDataSet[,5],dnn=list('predicted','actual'))

Chapter 06/3Decision tree learning - Predicting the Direction of Stock Movement.r


#' Pearson Correlation
#'
#' An optimized, efficient implemntation for computing the pearson
#' correlation.
#'
#' @details
#' See \code{?coop} for implementation details.
#'
#' @param x
#' A numeric dataframe/matrix or vector.
#' @param y
#' A vector (when \code{x} is a vector) or missing (blank) when
#' \code{x} is a matrix.
#' @param use
#' The NA handler, as in R's \code{cov()} and \code{cor()}
#' functions.  Options are "everything", "all.obs", and
#' "complete.obs".
#' @param inplace
#' Logical; if \code{TRUE} then the method used is slower but
#' uses less memory than if \code{FALSE}.  See \code{?coop-package}
#' for details.
#' @param inverse
#' Logical; should the inverse covariance matrix be returned?
#'
#' @return
#' The pearson correlation matrix.
#'
#' @examples
#' x <- matrix(rnorm(10*3), 10, 3)
#'
#' coop::pcor(x)
#' coop::pcor(x[, 1], x[, 2])
#'
#' @author Drew Schmidt
#' @seealso \code{\link{cosine}}
#' @name pcor
#' @rdname pcor
NULL

#' @rdname pcor
#' @export
pcor <- function(x, y, use="everything", inplace=FALSE, inverse=FALSE) UseMethod("pcor")

#' @export
pcor.matrix <- function(x, y, use="everything", inplace=FALSE, inverse=FALSE)
{
  co_matrix(x, y, CO_ORR, use, inplace, trans=FALSE, inverse=inverse)
}

#' @export
pcor.data.frame <- function(x, y, use="everything", inplace=FALSE, inverse=FALSE)
{
  x_mat = as.matrix(x)
  if (!missing(y) && is.data.frame(y))
    y = as.matrix(y)

  pcor.matrix(x_mat, y, use=use, inplace=inplace, inverse=inverse)
}

#' @export
pcor.default <- function(x, y, use="everything", inplace=FALSE, inverse=FALSE)
{
  co_vecvec(x, y, CO_ORR, use)
}

### tpcor

#' @rdname pcor
#' @export
tpcor <- function(x, y, use="everything", inplace=FALSE, inverse=FALSE) UseMethod("tpcor")

#' @export
tpcor.matrix <- function(x, y, use="everything", inplace=FALSE, inverse=FALSE)
{
  co_matrix(x, y, CO_ORR, use, inplace, trans=TRUE, inverse=inverse)
}

#' @export
tpcor.data.frame <- function(x, y, use="everything", inplace=FALSE, inverse=FALSE)
{
  x_mat = as.matrix(x)
  if (!missing(y) && is.data.frame(y))
    y = as.matrix(y)

  tpcor.matrix(x_mat, y, use=use, inplace=inplace, inverse=inverse)
}


library(quantmod)

stock <- na.omit(get(getSymbols('GOOG')))

x = Cl( stock )
y = SMA( Cl(stock), 5 )
row <- x > y
#View( cbind(x, y, row) )
pl <- setNames( rep( 0, length(x) ), time(stock) ) # [p]rofit and [l]ose vector
head(pl)

flag <- FALSE
long <- 0
for ( m in 6:nrow(stock) ) {
    if (flag == FALSE && row[m-1] == 0 && row[m] == 1) {
        long <- as.numeric( Op(stock)[m+1] )
        flag <- TRUE
    }
    if (flag == TRUE && row[m] == 0) {
        pl[m] <- as.numeric( Op(stock)[m+1] ) - long
        flag <- FALSE
    }
}

plot( cumsum(pl), type='l', col='red', lwd=2 )


#' Negative log likelihood function
#'
#' We're maximizing the likelihood function, so minimizing the negative log
#' likelihood (which is the default in optim)
#'
#' @param par  numeric vector of coefficients in ’x’ and theta
#' @param .x  design matrix of dimension ‘n * p’
#' @param .y  vector of observations of length ‘n’
#' @param weights  vector of weights of length ‘n’
#' @param offset  vector of coefficient offsets of length ‘n’
#' @param verbose  print debug messages
#' @return  negative log-likelihood of a set of paramters given the data
nll = function(par, .x, .y, weights=rep(1, nrow(.x)), offset=rep(0, nrow(.x)),
               .verbose=FALSE) {
    beta = par[-length(par)]
    theta = exp(par[length(par)])
    mu = .x %*% beta + offset

    if (.verbose)
        message(paste(sprintf("%.2f", par), collapse=", "))

    nb = suppressWarnings(stats::dnbinom(.y, mu=mu, size=theta, log=TRUE))
    nb[is.infinite(nb)] = sign(nb[is.infinite(nb)]) * 1000
    nb[is.na(nb)] = -mu[is.na(nb)] # penalize mu < 0
    -sum(weights * nb)
}


#CustomMath.r
#A collection of relatively basic functions.

MeanNA <- function(Vec) {
  #Replaces NA instances with their mean instead
  m <- mean(Vec, na.rm = TRUE)
  Vec[is.na(Vec)] <- m
  return(Vec)
}

GetWeight <- function(Vec,AddMean=FALSE) {
  #Takes a Vector, absolute value, then proportional linear deviance from 0.
  new <- abs(Vec)
  if(AddMean==1) new  <- new + mean(new)
  if(sum(new)==0) new <- new + 1
  new <- new/sum(new)
  return(new)
}

Catch <- function(X,Tolerance=0) {
  #x is the ConoutRAW numeric, Tolerance is the length of the midpoint corresponding to .5
  #The purpose here is to handle rounding for binary contracts
  if(X<(.5-(Tolerance/2))) return(0)
  else if(X>(.5+(Tolerance/2))) return(1)
  else return(.5)
}

Influence  <- function(Weight) {
  #Takes a normalized Vector (one that sums to 1), and computes relative strength of the indicators.
  #this is because by-default the conformity of each Author and Judge is expressed relatively.
  Expected <- rep(1/length(Weight),length(Weight))
  return( Weight / Expected)
}

ReWeight <- function(Vec,exclude=is.na(Vec)) {
  #Get the relative influence of numbers, treat NA as influence-less
  out <- Vec
  out[exclude] <- 0
  out <- out/sum(out)
  return(out)
}

ReverseMatrix <- function(Mat) {
  #Inverts a binary matrix
  return((Mat-1)*-1)
}

WeightedPrinComp <- function(X,Weights=ReWeight(rep(1,nrow(M))) ) {
  #Manually computes the statistical procedure known as Principal Components Analysis (PCA)
  #This version of the procedure is so basic, that it can also be thought of as merely a singular-value decomposition on a weighted covariance matrix.

  wCVM <- cov.wt(x=X,wt=Weights)

  L <- svd(wCVM$cov)$u[,1]
  S <- as.vector(scale(X,center=wCVM$center,scale= FALSE) %*% L)

  Out <- list("Scores"=S,"Loadings"=L)
  return(Out)
}


dist_base <- 100
comp_dist <- function(x) log2(dist_base - x)
plot(comp_dist, xlim=c(0, 100))

stair <- function(x) { tmp <- log2(x); 1.0 - tmp / (-5.0)}
plot(stair, xlim=c(0, 1.0))

max_depth <- 10
comp_search <- function(x) log2(max_depth - x)
plot(comp_search, xlim=c(0, 10))