[Returnanalytics-commits] r2069 - pkg/PerformanceAnalytics/sandbox/Meucci/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 25 03:31:08 CEST 2012
Author: mkshah
Date: 2012-06-25 03:31:06 +0200 (Mon, 25 Jun 2012)
New Revision: 2069
Modified:
pkg/PerformanceAnalytics/sandbox/Meucci/R/FullyFlexibleBayesNets.R
Log:
Code cleaning
Modified: pkg/PerformanceAnalytics/sandbox/Meucci/R/FullyFlexibleBayesNets.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Meucci/R/FullyFlexibleBayesNets.R 2012-06-24 22:48:40 UTC (rev 2068)
+++ pkg/PerformanceAnalytics/sandbox/Meucci/R/FullyFlexibleBayesNets.R 2012-06-25 01:31:06 UTC (rev 2069)
@@ -13,56 +13,55 @@
#' @author Ram Ahluwalia \email{ram@@wingedfootcapital.com}
CondProbViews = function( View , X )
{
- # initialize parameters
- A = matrix( , nrow = 0 , ncol = nrow( X ) )
- b = g = matrix( , nrow = 0 , ncol = 1 )
+ # initialize parameters
+ A = matrix( , nrow = 0 , ncol = nrow( X ) )
+ b = g = matrix( , nrow = 0 , ncol = 1 )
- # for each view...
- for ( k in 1:length( View ) ) {
+ # for each view...
+ for ( k in 1:length( View ) ) {
+ I_mrg = ( X[ , 1] < Inf )
- I_mrg = ( X[ , 1] < Inf )
+ for ( s in 1:length( View[[k]]$Who ) )
+ {
+ Who = View[[k]]$Who[s]
+ Or_Targets = View[[k]]$Equal[[s]]
+ I_mrg_or = ( X[ , Who] > Inf )
+ for ( i in 1:length( Or_Targets ) ) { I_mrg_or = I_mrg_or | ( X[ , Who ] == Or_Targets[i] ) } # element-wise logical OR
+ I_mrg = I_mrg & I_mrg_or # element-wise logical AND
+ }
- for ( s in 1:length( View[[k]]$Who ) )
- {
- Who = View[[k]]$Who[s]
- Or_Targets = View[[k]]$Equal[[s]]
- I_mrg_or = ( X[ , Who] > Inf )
- for ( i in 1:length( Or_Targets ) ) { I_mrg_or = I_mrg_or | ( X[ , Who ] == Or_Targets[i] ) } # element-wise logical OR
- I_mrg = I_mrg & I_mrg_or # element-wise logical AND
- }
+ I_cnd = ( X[ , 1 ] < Inf )
- I_cnd = ( X[ , 1 ] < Inf )
+ if ( length( View[[k]]$Cond_Who ) != 0) # If length of Cond_Who is zero, skip
+ {
+ for ( s in 1:length( View[[k]]$Cond_Who ) )
+ {
+ Who = View[[k]]$Cond_Who[s]
+ Or_Targets = View[[k]]$Cond_Equal[[s]]
+ I_cnd_or = ( X[ , Who ] > Inf )
+ for ( i in 1:length( Or_Targets ) ) { I_cnd_or = I_cnd_or | X[ ,Who ] == Or_Targets[i] }
+ I_cnd = I_cnd & I_cnd_or
+ }
+ }
- if ( length( View[[k]]$Cond_Who ) != 0) # If length of Cond_Who is zero, skip
- {
- for ( s in 1:length( View[[k]]$Cond_Who ) )
- {
- Who = View[[k]]$Cond_Who[s]
- Or_Targets = View[[k]]$Cond_Equal[[s]]
- I_cnd_or = ( X[ , Who ] > Inf )
- for ( i in 1:length( Or_Targets ) ) { I_cnd_or = I_cnd_or | X[ ,Who ] == Or_Targets[i] }
- I_cnd = I_cnd & I_cnd_or
- }
- }
+ I_jnt=I_mrg & I_cnd
- I_jnt=I_mrg & I_cnd
-
- if ( !isempty( View[[k]]$Cond_Who ) )
- {
- New_A = View[[k]]$sgn %*% t( (I_jnt - View[[k]]$v * I_cnd) )
- New_b = 0
- }
- else
- {
- New_A = View[[k]]$sgn %*% t( I_mrg )
- New_b = View[[k]]$sgn %*% View[[k]]$v
- }
-
- A = rbind( A , New_A ) # constraint for the conditional expectations...
- b = rbind( b , New_b )
- g = rbind( g , -log( 1 - View[[k]]$c ) )
+ if ( !isempty( View[[k]]$Cond_Who ) )
+ {
+ New_A = View[[k]]$sgn %*% t( (I_jnt - View[[k]]$v * I_cnd) )
+ New_b = 0
}
- return( list( A = A , b = b , g = g ) )
+ else
+ {
+ New_A = View[[k]]$sgn %*% t( I_mrg )
+ New_b = View[[k]]$sgn %*% View[[k]]$v
+ }
+
+ A = rbind( A , New_A ) # constraint for the conditional expectations...
+ b = rbind( b , New_b )
+ g = rbind( g , -log( 1 - View[[k]]$c ) )
+ }
+ return( list( A = A , b = b , g = g ) )
}
#' @param A matrix A consisting of inequality constraints ( Ax <= b )
@@ -74,40 +73,38 @@
#' @author Ram Ahluwalia \email{ram@@wingedfootcapital.com}
Tweak = function( A , b , g )
{
- library( matlab )
- library( limSolve )
+ library( matlab )
+ library( limSolve )
- K = nrow( A )
- J = ncol( A )
+ K = nrow( A )
+ J = ncol( A )
- browser()
+ g_ = rbind( g , zeros( J , 1 ) )
- g_ = rbind( g , zeros( J , 1 ) )
+ Aeq_ = cbind( zeros( 1 , K ) , ones( 1 , J ) )
+ beq_ = 1
- Aeq_ = cbind( zeros( 1 , K ) , ones( 1 , J ) )
- beq_ = 1
+ lb_ = rbind( zeros( K , 1 ) , zeros( J , 1 ) )
+ ub_ = rbind( Inf * ones( K , 1 ) , ones( J , 1 ) )
- lb_ = rbind( zeros( K , 1 ) , zeros( J , 1 ) )
- ub_ = rbind( Inf * ones( K , 1 ) , ones( J , 1 ) )
+ A_ = cbind( -eye( K ) , A )
+ b_ = b
- A_ = cbind( -eye( K ) , A )
- b_ = b
+ # add lower-bound and upper-bound constraints
+ A_ = rbind( A_ , -eye(ncol(A_)) )
+ b_ = rbind( b_ , rep( 0 , ncol(A_)) )
- # add lower-bound and upper-bound constraints
- A_ = rbind( A_ , -eye(ncol(A_)) )
- b_ = rbind( b_ , rep( 0 , ncol(A_)) )
+ x0 = rep( 1/ncol( Aeq_ ) , ncol( Aeq_ ) )
+ # db_ = linprog( g_ , A_ , b_ , Aeq_ ,beq_ , lb_ , ub_ ) # MATLAB version
+ optimResult = linp( E = Aeq_ , # matrix containing coefficients of equality constraints Ex=F
+ F = beq_ , # vector containing the right-hand side of equality constraints
+ G = -1*A_ , # matrix containint coefficients of the inequality constraints GX >= H
+ H = -1*b_ , # vector containing the right-hand side of the inequality constraints
+ Cost = -1*g_ , # vector containing the coefficients of the cost function
+ ispos = FALSE )
- x0 = rep( 1/ncol( Aeq_ ) , ncol( Aeq_ ) )
- # db_ = linprog( g_ , A_ , b_ , Aeq_ ,beq_ , lb_ , ub_ ) # MATLAB version
- optimResult = linp( E = Aeq_ , # matrix containing coefficients of equality constraints Ex=F
- F = beq_ , # vector containing the right-hand side of equality constraints
- G = -1*A_ , # matrix containint coefficients of the inequality constraints GX >= H
- H = -1*b_ , # vector containing the right-hand side of the inequality constraints
- Cost = -1*g_ , # vector containing the coefficients of the cost function
- ispos = FALSE )
-
- costFunction = function( x ) { matrix( x , nrow = 1 ) %*% matrix( -1*g_ , ncol = 1) }
- optimResult = optim( par = x0 ,
+ costFunction = function( x ) { matrix( x , nrow = 1 ) %*% matrix( -1*g_ , ncol = 1) }
+ optimResult = optim( par = x0 ,
fn = costFunction , # CHECK
gr = -1*g_ ,
method = "L-BFGS-B",
@@ -116,20 +113,20 @@
hessian = FALSE )
- library( linprog )
- optimResult2 = solveLP( E = Aeq_ , # numeric matrix containing coefficients of equality constraints Ex=F
- F = beq_ , # numeric vector containing the right-hand side of equality constraints
- G = -1*A_ , # numeric matrix containint coefficients of the inequality constraints GX >= H
- H = -1*b_ , # numeric vector containing the right-hand side of the inequality constraints
- Cost = -g_ , # numeric vector containing the coefficients of the cost function
- ispos = FALSE )
+ library( linprog )
+ optimResult2 = solveLP( E = Aeq_ , # numeric matrix containing coefficients of equality constraints Ex=F
+ F = beq_ , # numeric vector containing the right-hand side of equality constraints
+ G = -1*A_ , # numeric matrix containint coefficients of the inequality constraints GX >= H
+ H = -1*b_ , # numeric vector containing the right-hand side of the inequality constraints
+ Cost = -g_ , # numeric vector containing the coefficients of the cost function
+ ispos = FALSE )
- db_ = optimResult$X
+ db_ = optimResult$X
- db = db_[ 1:K ]
+ db = db_[ 1:K ]
- return( db )
+ return( db )
}
@@ -147,12 +144,12 @@
#' @export
ComputeMoments = function( X , p )
{
- library( matlab )
- J = nrow( X ) ; N = ncol( X )
- m = t(X) %*% p
- Sm = t(X) %*% (X * repmat( p , 1 , N ) ) # repmat : repeats/tiles a matrix
- S = Sm - m %*% t(m)
- C = cov2cor( S ) # the correlation matrix
- s = sqrt( diag( S ) ) # the vector of standard deviations
- return( list( means = m , sd = s , correlationMatrix = C ) )
+ library( matlab )
+ J = nrow( X ) ; N = ncol( X )
+ m = t(X) %*% p
+ Sm = t(X) %*% (X * repmat( p , 1 , N ) ) # repmat : repeats/tiles a matrix
+ S = Sm - m %*% t(m)
+ C = cov2cor( S ) # the correlation matrix
+ s = sqrt( diag( S ) ) # the vector of standard deviations
+ return( list( means = m , sd = s , correlationMatrix = C ) )
}
More information about the Returnanalytics-commits
mailing list