# Copyright (c) 2018 Kelvin Say
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.


# ---------------------------------------------------------------------------------------------------------------
# Take a 2D array and convert it into a 3D array while assuming that the first colum is repeated for the entire
# length_y distance in the first layer, and the second column is repeated for the entire length_y distance in the
# second layer, etc.
#                                    #2    1 .. length_y
#  #1  #2        #1   1  .. length_y     | E | E | E | E |
# | A | E |        | A | A | A | A |     | F | F | F | F |
# | B | F | ==>    | B | B | B | B |     | G | G | G | G |
# | C | G |        | C | C | C | C |
# ---------------------------------------------------------------------------------------------------------------
crossfill_2D_3D_matrix <- function(m_2d, length_y) {
  depth_z <- length(m_2d[1,])
  length_x <- length(m_2d[,1])
  data <- NULL
  for (z in 1:depth_z) {
    data <- c(data, rep(m_2d[,z], length_y))
  }
  return(array(data, dim = c(length_x, length_y, depth_z)))
}

# ---------------------------------------------------------------------------------------------------------------
# Take a 1D array and convert it into a 3D array while assuming that the first element is repeated for the entire
# length_x / length_y domanin in the first layer, and the second element is repeated for the entire
# length_x/length_y distance in the second layer, etc.
#                                            #2    1 .. length_y
#  #1  #2        #1   1  .. length_y             | Z | Z | Z | Z | 1
# | A | Z | ==>    | A | A | A | A | 1           | Z | Z | Z | Z | ..
#                  | A | A | A | A | ..          | Z | Z | Z | Z | length_x
#                  | A | A | A | A | length_x
# ---------------------------------------------------------------------------------------------------------------
# Take a 1D
# ---------------------------------------------------------------------------------------------------------------
crossfill_1D_3D_matrix <- function(m_1d, length_x, length_y) {
  depth_z <- length(m_1d)
  data <- NULL
  for (z in 1:depth_z) {
    data <- c(data, rep(m_1d[z], length_x*length_y))
  }
  return(array(data, dim = c(length_x, length_y, depth_z)))
}

# ---------------------------------------------------------------------------------------------------------------
# Calculate the discounted payback period for a given cashflow
# ---------------------------------------------------------------------------------------------------------------
dpb <- function(i.d_rate, i.cf) {
  discounted_payback_yrs <- Inf
  culmulative <- 0
  prev_culmulative <- 0
  if (i.cf[1] < 0) {
    for (i in 1:length(i.cf)) {
      year <- i - 1
      prev_culmulative <- culmulative
      if (year == 0) {
        discounted_cf <- i.cf[i]
      } else {
        discounted_cf <- (i.cf[i] / ((1+i.d_rate) ^ year))
      }
      culmulative <- prev_culmulative + discounted_cf
      if (culmulative > 0) {
        discounted_payback_yrs <- (year - 1) + (-prev_culmulative / discounted_cf)
        break
      }
    }
  }
  return (discounted_payback_yrs)
}

# ---------------------------------------------------------------------------------------------------------------
# Multiple plot function
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols:   Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
# http://www.cookbook-r.com/Graphs/Multiple_graphs_on_one_page_(ggplot2)/
# ---------------------------------------------------------------------------------------------------------------
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  library(grid)

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)

  numPlots = length(plots)

  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                     ncol = cols, nrow = ceiling(numPlots/cols))
  }

  if (numPlots==1) {
    print(plots[[1]])

  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}

print_Leading_Sign <- function(x) {
  if (x >= 0) {
    s <- paste0("+ ", x)
  } else {
    s <- paste0("- ", abs(x))
  }
  return(s)
}

print_percentile <- function(x) {
  s <- as.character(round(x*100,0))
  if ((str_sub(s, start=-1, end=-1)) == 1) {
    postfix <- "st"
  } else {
    if ((str_sub(s, start=-1, end=-1)) == 2) {
      postfix <- "nd"
    } else {
      if ((str_sub(s, start=-1, end=-1)) == 3) {
        postfix <- "rd"
      } else {
        postfix <- "th"
      }
    }
  }
  s <- paste0(s, postfix, " percentile")
  return(s)
}

print_Growth_Rate <- function(x) {
  if (x >= 0) {
    s <- paste0(x*100, "%pa")
  } else {
    s <- paste0("(", abs(x*100), ')%pa')
  }
  return(s)
}