# ------------------------------------------------------------------------------
# Analysis of intraday leverage of der-forex-millionaer.de
#
# created 2009 by Perfect Trader <mailto:trading.smart@gmail.com>
# ------------------------------------------------------------------------------
#
# This script is a supplement to a forum post at <http://www.candletalk.de/>
# about the subject of leverage of der-forex-millionaer.de by Kay Brendel.
# It draws a graph to explain the degree of leverage used by him.
#
# This script itself was created at 2009-09-24 by user Perfect Trader
# at forum <http://www.candletalk.de/> and is released to public domain.
# You can use and modify it without prior permission for any purpose.
#
# It uses the statistics software system R <http://www.r-project.org/>
# which is publicly available for download without charge from this address.
#
# To run this script you can use the R command source().
# Instead you can copy it even to the R console with copy and paste.
# You get some graphs as output without any necessary input file other
# than the budled input data file 'Leverage with zeros.csv' and without any
# modifications of files on your system.
# ------------------------------------------------------------------------------


# global input directory and file configuration

configure <- function(remove = FALSE)
{ if ( ! remove )
    Config <<- list(
    # files
      baseDir         = 'E:/User/... YOUR PATH ...'
    , dataFile        = 'csv/Leverage with zeros.csv'
    , dateFormat      = '%d.%m.%Y %H:%M'
    , images          = 'images/Leverages intraday/per Months/'

    # graphical layout
    , adj             = 1.2
    , cex             = 1.2 # 0.65
    , bigTick         = 6
    , bigTickLength   = 0.045
    , bigTickWidth    = 3
    , color           = list(
        bg            = '#D8D8D8' # 'white' # for printer
      , grid          = '#606060'
      , line          = '#0000FF'
      )
    , deviceHeight    = 1000
    , deviceWidth     = 1250
    , gridPerHours    = 3
    , gridPerLeverage = 5
    , lwd             = 1
    , mar             = c(2, 2, 2, 1)     # bltr
    , mgp             = c(1.85, 0.6, 0)   # axis title, labels, line
    , panelHeight     = 6
    , panelWidth      = 8
    )
  else
    rm(pos = 1, list = c(
      'Config'
    , 'configure'
    , 'main'
    , 'readInput'
    , 'getMonthLayouts'
    , 'plotAll'
    , 'plotLeverages'
    , 'splitToTimeIntervals'
    , 'passThrough'
    ))
}


# main function

main <- function(interactive = TRUE)
{ configure()

  leverages    <- readInput()

  monthLayouts <- getMonthLayouts(names(leverages))

  plotAll(leverages, monthLayouts, interactive)

  configure(remove = TRUE)
}


# read input file and convert date field to right internal format

readInput <- function()
{ setwd(Config $ baseDir)

  leverages        <- read.table(file = Config $ dataFile, header = TRUE, sep = '\t')
  leverages $ time <- as.POSIXct(as.vector(leverages $ time), format = Config $ dateFormat)

  maxLeverage      <- max(leverages $ leverage)
  # split intraday values per day
  leverages        <- splitToTimeIntervals(leverages, leverages $ time, 'days')

  # note 'maxLeverage' as attribute instead of transfer as global value
  attr(leverages, 'maxLeverage') <- maxLeverage

  # enforce continous line for 24 hours, even if nothing happened
  for ( day in 1 : length(leverages) )
  { start <- if ( day == 1 )leverages[[day    ]][1                                   , ]
      else                  leverages[[day - 1]][length(leverages[[day - 1]] $ time) , ]
    end   <-                leverages[[day    ]][length(leverages[[day    ]] $ time) , ]

    start $ time <- startTime <- as.POSIXct(names(leverages)[day])
    end   $ time <- startTime + 86400

    leverages[[day]] <- rbind(start, leverages[[day]], end)
  }

  return(leverages)
}


# split the data into months for nice page arrangement

getMonthLayouts <- function(days)
{ monthLayouts               <- NULL
  monthLayouts $ days        <- splitToTimeIntervals(days, days, 'months')
  names(monthLayouts $ days) <- substr(names(monthLayouts $ days), 1, 7)

  for ( month in names(monthLayouts $ days) )
  { monthLayouts $ weeks[[month]] <- splitToTimeIntervals(
      monthLayouts $ days[[month]]
    , monthLayouts $ days[[month]], 'weeks')

    monthLayouts $ layouts[[month]] <-
      matrix(1 : (length(monthLayouts $ weeks[[month]]) * 5), ncol = 5, byrow = TRUE)
  }

  return(monthLayouts)
}


# whole plotting incl. layout arrangement

plotAll <- function(leverages, monthLayouts, interactive = TRUE)
{ maxLeverage <- attr(leverages, 'maxLeverage')

  for ( month in names(monthLayouts $ layout) )
  { if ( ! interactive )
    { png(paste(Config $ images, month, '.png', sep = '')
      , Config $ deviceWidth, Config $ deviceHeight, restoreConsole = TRUE)
      message('Creating graph for ', month)
      flush.console()
    }

    if ( interactive ) devAskNewPage(ask = TRUE)

    par(bg = Config $ color $ bg)

    monthLayout <- monthLayouts $ layout[[month]]

    unit <- if ( interactive ) passThrough else lcm
    layout(monthLayout
    , rep(unit(Config $ panelWidth ), ncol(monthLayout))
    , rep(unit(Config $ panelHeight), nrow(monthLayout)))

    for ( week in names(monthLayouts $ weeks[[month]]) )
    { expectedDay <- as.Date(week)
      for ( day in monthLayouts $ weeks[[month]][[week]] )
      { while ( expectedDay != as.Date(day) )
        { plot.new()
          expectedDay <- expectedDay + 1
        }

        plotLeverages(leverages[day], maxLeverage)
        expectedDay <- expectedDay + 1
    } }

    if ( ! interactive ) graphics.off()
} }


# plot leverage data for one day in one graph

plotLeverages <- function(leverages, maxLeverage)
{ day <- names(leverages)

  start     <- as.POSIXct(names(leverages)[1])
  end       <- start + 86400
  ylim      <- c(0, maxLeverage)
  par(
    bg       = Config $ color $ bg
  , cex.axis = Config $ cex
  , cex.lab  = Config $ cex
  , las      = 1
  , mar      = Config $ mar
  , mgp      = Config $ mgp
  )

  plot(leverages[[1]] $ time, leverages[[1]] $ leverage
  , col  = Config $ color $ line
  , lwd  = Config $ lwd
  , main = day
  , type = 's'
  , xaxt = 'n'
  , xlab = ''
  , xlim = c(start, end)
  , ylab = ''
  , ylim = ylim
  )
  labelPos <- seq(start, to = end, by = '1 hour')
  axis(1, at = labelPos, labels = FALSE)

  options(warn = -1)
    bigLabelPos <- split(labelPos, rep(1 : Config $ bigTick))[[1]]
  options(warn = 0)
  axis(1, at = bigLabelPos, labels = format(bigLabelPos, '%H:%M'), lwd.ticks = Config $ bigTickWidth)

  options(warn = -1)
    hours <- split(labelPos, c(1:Config $ gridPerHours))[[1]]
  options(warn = 0)
  for ( hour in hours )
    abline(v = hour, lty = 'dotted')

  for ( leverage in seq(0, maxLeverage, Config $ gridPerLeverage) )
    abline(h = leverage, lty = 'dotted')
}


# split a time intervall in sub intervals

splitToTimeIntervals <- function(whatToSplit, times, interval)
{ items         <- cut(as.POSIXct(times), interval)
  uniqueItems   <- unique(items)
  result        <- split(whatToSplit, findInterval(items, uniqueItems))
  names(result) <- uniqueItems

  return(result)
}


# helper function for place holding for passing its argument

passThrough <- function(x) x


# do the whole work due to calling the main function

main(FALSE)
# main()

# run <- function() source('Leverage intraday (page per month).R')