[Returnanalytics-commits] r3717 - in pkg/Meucci: R demo man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jun 23 10:26:44 CEST 2015
Author: xavierv
Date: 2015-06-23 10:26:43 +0200 (Tue, 23 Jun 2015)
New Revision: 3717
Modified:
pkg/Meucci/R/EntropyProg.R
pkg/Meucci/demo/HermiteGrid_demo.R
pkg/Meucci/man/pHist.Rd
Log:
- fixed HermiteGrid_demo demo script
Modified: pkg/Meucci/R/EntropyProg.R
===================================================================
--- pkg/Meucci/R/EntropyProg.R 2015-06-23 06:54:57 UTC (rev 3716)
+++ pkg/Meucci/R/EntropyProg.R 2015-06-23 08:26:43 UTC (rev 3717)
@@ -301,6 +301,9 @@
#' @param nBins expected number of Bins the data set is to be broken down into
#' @param freq boolean variable to indicate whether the graphic is a
#' representation of frequencies
+#' @param main title for the plot
+#' @param xlim limits for the x-axis
+#' @param ylim limits for the y-axis
#'
#' @return a list with
#' f the frequency for each midpoint
@@ -314,7 +317,9 @@
#'
#' @export
-PHist <- function(X, p, nBins, freq = FALSE) {
+PHist <- function(X, p, nBins, freq = FALSE,
+ main = "Portfolio return distribution",
+ xlim = NULL, ylim = NULL) {
if (length(match.call()) < 3) {
J <- dim(X)[1]
@@ -336,7 +341,7 @@
f <- np / D
}
- plot(x, f, type = "h", main = "Portfolio return distribution")
+ plot(x, f, type = "h", main = main, xlim = xlim, ylim = ylim)
return(list(f = f, x = x))
}
Modified: pkg/Meucci/demo/HermiteGrid_demo.R
===================================================================
--- pkg/Meucci/demo/HermiteGrid_demo.R 2015-06-23 06:54:57 UTC (rev 3716)
+++ pkg/Meucci/demo/HermiteGrid_demo.R 2015-06-23 08:26:43 UTC (rev 3717)
@@ -14,18 +14,19 @@
################################################################################
# analytical (normal) prior
emptyMatrix <- matrix(nrow = 0, ncol = 0)
-market.mu <- 0.0
-market.sig2 <- 1.0
-market.pdf <- function(x) dnorm(x, mean = market.mu, sd = sqrt(market.sig2))
-market.cdf <- function(x) pnorm(x, mean = market.mu, sd = sqrt(market.sig2))
-market.rnd <- function(x) rnorm(x, mean = market.mu, sd = sqrt(market.sig2))
-market.inv <- function(x) qnorm(x, mean = market.mu, sd = sqrt(market.sig2))
+market <- list()
+market$mu <- 0.0
+market$sig2 <- 1.0
+market$pdf <- function(x) dnorm(x, mean = market$mu, sd = sqrt(market$sig2))
+market$cdf <- function(x) pnorm(x, mean = market$mu, sd = sqrt(market$sig2))
+market$rnd <- function(x) rnorm(x, mean = market$mu, sd = sqrt(market$sig2))
+market$inv <- function(x) qnorm(x, mean = market$mu, sd = sqrt(market$sig2))
# numerical (Monte Carlo) prior
monteCarlo <- emptyMatrix
-monteCarlo.J <- 100000
-monteCarlo.X <- market.rnd(monteCarlo.J)
-monteCarlo.p <- normalizeProb(1 / monteCarlo.J * ones(monteCarlo.J, 1))
+monteCarlo$J <- 100000
+monteCarlo$X <- market$rnd(monteCarlo$J)
+monteCarlo$p <- normalizeProb(1 / monteCarlo$J * ones(monteCarlo$J, 1))
# numerical (Gauss-Hermite grid) prior
ghqMesh <- emptyMatrix
@@ -33,56 +34,67 @@
# rescale GH zeros so they belong to [0,1]
tmp <- (ghqx - min(ghqx)) / (max(ghqx) - min(ghqx))
epsilon <- 1e-10
-Lower <- market.inv(epsilon)
-Upper <- market.inv(1 - epsilon)
-ghqMesh.X <- Lower + tmp * (Upper - Lower) # rescale mesh
+Lower <- market$inv(epsilon)
+Upper <- market$inv(1 - epsilon)
+ghqMesh$X <- Lower + tmp * (Upper - Lower) # rescale mesh
-p <- integrateSubIntervals(ghqMesh.X, market.cdf)
-ghqMesh.p <- normalizeProb(p)
-ghqMesh.J <- nrow(ghqMesh.X)
+p <- integrateSubIntervals(ghqMesh$X, market$cdf)
+ghqMesh$p <- normalizeProb(p)
+ghqMesh$J <- nrow(ghqMesh$X)
################################################################################
# Entropy posterior from extreme view on expectation
################################################################################
# view of the analyst
view <- emptyMatrix
-view.mu <- -3.0
+view$mu <- -3.0
# analytical (known since normal model has analytical solution)
truePosterior <- emptyMatrix
-truePosterior <- Prior2Posterior(market.mu, 1, view.mu, market.sig2, 0)
-truePosterior$pdf <- function(x) dnorm(x, truePosterior.mu,
- sqrt(truePosterior.sig2))
+truePosterior <- Prior2Posterior(market$mu, 1, view$mu, market$sig2, 0)
+truePosterior$pdf <- function(x) dnorm(x, truePosterior$M_,
+ sqrt(truePosterior$S_))
# numerical (Monte Carlo)
-Aeq <- rbind(ones(1, monteCarlo.J), t(monteCarlo.X))
-beq <- rbind(1, view.mu)
-monteCarloOptimResult <- EntropyProg(monteCarlo.p, emptyMatrix, emptyMatrix, Aeq,
+Aeq <- rbind(ones(1, monteCarlo$J), t(monteCarlo$X))
+beq <- rbind(1, view$mu)
+monteCarloOptimResult <- EntropyProg(monteCarlo$p, emptyMatrix, emptyMatrix, Aeq,
beq)
-monteCarlo.p_ <- monteCarloOptimResult$p_
-monteCarlo.KLdiv <- monteCarloOptimResult$optimizationPerformance$ml
+monteCarlo$p_ <- monteCarloOptimResult$p_
+monteCarlo$KLdiv <- monteCarloOptimResult$optimizationPerformance$ml
# numerical (Gaussian-Hermite grid)
-Aeq <- rbind(ones(1, ghqMesh.J), t(ghqMesh.X))
-beq <- rbind(1, view.mu)
-ghqMeshOptimResult <- EntropyProg(ghqMesh.p, emptyMatrix, emptyMatrix, Aeq, beq)
+Aeq <- rbind(ones(1, ghqMesh$J), t(ghqMesh$X))
+beq <- rbind(1, view$mu)
+ghqMeshOptimResult <- EntropyProg(ghqMesh$p, emptyMatrix, emptyMatrix, Aeq, beq)
-ghqMesh.p_ <- ghqMeshOptimResult$p_
-ghqMesh.KLdiv <- ghqMeshOptimResult$optimizationPerformance$ml
+ghqMesh$p_ <- ghqMeshOptimResult$p_
+ghqMesh$KLdiv <- ghqMeshOptimResult$optimizationPerformance$ml
################################################################################
# Plots
################################################################################
-xmin <- min(ghqMesh.X)
-xmax <- max(ghqMesh.X)
+xmin <- min(ghqMesh$X)
+xmax <- max(ghqMesh$X)
ymax <- 1.0
-xmesh <- t(linspace(xmin, xmax, ghqMesh.J))
+xmesh <- t(linspace(xmin, xmax, ghqMesh$J))
# Monte Carlo
-plotDataMC <- PHist(monteCarlo.X, monteCarlo.p_, 50)
-lines(plotDataMC$x, plotDataMC$f, type = "l", col = "red")
+dev.new()
+plotDataMC <- PHist(monteCarlo$X, monteCarlo$p_, 50, main = "Monte Carlo",
+ xlim = c(xmin, xmax), ylim = c(0, ymax))
+lines(xmesh, market$pdf(xmesh), type = "l", col = "blue")
+lines(xmesh, truePosterior$pdf(xmesh), type = "l", col = "red")
+lines(0.0, 0.0, type = "p", pch = 17, col = "blue")
+lines(view.mu, 0.0, type = "p", pch = 17, col = "red")
# Gauss Hermite Grid
-plotDataGHQ <- PHist(data.matrix(ghqMesh.X), ghqMesh.p_, 50)
-lines(plotDataGHQ$x, plotDataGHQ$f, type = "l", col = "red")
+dev.new()
+plotDataGHQ <- PHist(data.matrix(ghqMesh$X), ghqMesh$p_, 50,
+ main = "Gauss-Hermite grid",
+ xlim = c(xmin, xmax), ylim = c(0, ymax))
+lines(xmesh, market$pdf(xmesh), type = "l", col = "blue")
+lines(xmesh, truePosterior$pdf(xmesh), type = "l", col = "red")
+lines(0.0, 0.0, type = "p", pch = 17, col = "blue")
+lines(view$mu, 0.0, type = "p", pch = 17, col = "red")
Modified: pkg/Meucci/man/pHist.Rd
===================================================================
--- pkg/Meucci/man/pHist.Rd 2015-06-23 06:54:57 UTC (rev 3716)
+++ pkg/Meucci/man/pHist.Rd 2015-06-23 08:26:43 UTC (rev 3717)
@@ -4,7 +4,8 @@
\alias{PHist}
\title{Generates histogram}
\usage{
-PHist(X, p, nBins, freq = FALSE)
+PHist(X, p, nBins, freq = FALSE, main = "Portfolio return distribution",
+ xlim = NULL, ylim = NULL)
}
\arguments{
\item{X}{vector containing the data points}
@@ -15,7 +16,13 @@
\item{nBins}{expected number of Bins the data set is to be broken down into}
\item{freq}{boolean variable to indicate whether the graphic is a
- representation of frequencies}
+representation of frequencies}
+
+\item{main}{title for the plot}
+
+\item{xlim}{limits for the x-axis}
+
+\item{ylim}{limits for the y-axis}
}
\value{
a list with
More information about the Returnanalytics-commits
mailing list