fPortfolio/0000755000175100001440000000000013630700055012412 5ustar hornikusersfPortfolio/NAMESPACE0000644000175100001440000001210313202342267013630 0ustar hornikusers################################################################################ ## Exports ################################################################################ exportPattern("^[^\\.]") # Needed within the portfolio book export(.fportfolio.plot.1) export(.fportfolio.plot.2) export(.fportfolio.plot.3) export(.fportfolio.plot.4) export(.fportfolio.plot.5) export(.fportfolio.plot.6) export(.fportfolio.plot.7) export(.fportfolio.plot.8) ################################################################################ ## Imports ################################################################################ import(methods) import(timeDate) import(timeSeries) import(fBasics) import(fAssets) import(fCopulae) import(robustbase) import(MASS) import(Rglpk) import(slam) import(Rsolnp) import(quadprog) import(kernlab) import(rneos) importFrom("grDevices", heat.colors, rainbow, topo.colors) importFrom("graphics", axis, barplot, box, contour, grid, hist, image, layout, lcm, legend, mtext, par, pie, plot.new, plot.window, polygon, rect, text, title) importFrom("stats", approx, cov, density, dnorm, nlminb, optim, optimize, pnorm, qnorm, rcauchy, rnorm, runif, sd, ts.plot, var, weights) importFrom("utils", capture.output, data, packageDescription) ################################################################################ ## S3 Exports ################################################################################ S3method("print", "solver") S3method("getData", "fPFOLIODATA") S3method("getSeries", "fPFOLIODATA") S3method("getNAssets", "fPFOLIODATA") S3method("getUnits", "fPFOLIODATA") S3method("getStatistics", "fPFOLIODATA") S3method("getMean", "fPFOLIODATA") S3method("getCov", "fPFOLIODATA") S3method("getEstimator", "fPFOLIODATA") S3method("getMu", "fPFOLIODATA") S3method("getSigma", "fPFOLIODATA") S3method("getTailRisk", "fPFOLIODATA") S3method("plot", "fPORTFOLIO") S3method("summary", "fPORTFOLIO") S3method("getData", "fPORTFOLIO") S3method("getSeries", "fPORTFOLIO") S3method("getNAssets", "fPORTFOLIO") S3method("getUnits", "fPORTFOLIO") S3method("getStatistics", "fPORTFOLIO") S3method("getMean", "fPORTFOLIO") S3method("getCov", "fPORTFOLIO") S3method("getEstimator", "fPORTFOLIO") S3method("getMu", "fPORTFOLIO") S3method("getSigma", "fPORTFOLIO") S3method("getSpec", "fPORTFOLIO") S3method("getModel", "fPORTFOLIO") S3method("getType", "fPORTFOLIO") S3method("getOptimize", "fPORTFOLIO") S3method("getEstimator", "fPORTFOLIO") S3method("getTailRisk", "fPORTFOLIO") S3method("getParams", "fPORTFOLIO") S3method("getAlpha", "fPORTFOLIO") S3method("getA", "fPORTFOLIO") S3method("getPortfolio", "fPORTFOLIO") S3method("getWeights", "fPORTFOLIO") S3method("getTargetReturn", "fPORTFOLIO") S3method("getTargetRisk", "fPORTFOLIO") S3method("getRiskFreeRate", "fPORTFOLIO") S3method("getNFrontierPoints", "fPORTFOLIO") S3method("getStatus", "fPORTFOLIO") S3method("getOptim", "fPORTFOLIO") S3method("getSolver", "fPORTFOLIO") S3method("getObjective", "fPORTFOLIO") S3method("getOptions", "fPORTFOLIO") S3method("getControl", "fPORTFOLIO") S3method("getTrace", "fPORTFOLIO") S3method("getCovRiskBudgets", "fPORTFOLIO") S3method("getConstraints", "fPORTFOLIO") S3method("getTailRiskBudgets", "fPORTFOLIO") S3method("getPortfolio", "fPFOLIOVAL") S3method("getWeights", "fPFOLIOVAL") S3method("getCovRiskBudgets", "fPFOLIOVAL") S3method("getTargetReturn", "fPFOLIOVAL") S3method("getTargetRisk", "fPFOLIOVAL") S3method("getAlpha", "fPFOLIOVAL") S3method("getRiskFreeRate", "fPFOLIOVAL") S3method("getNFrontierPoints", "fPFOLIOVAL") S3method("getStatus", "fPFOLIOVAL") S3method("getModel", "fPFOLIOSPEC") S3method("getType", "fPFOLIOSPEC") S3method("getOptimize", "fPFOLIOSPEC") S3method("getEstimator", "fPFOLIOSPEC") S3method("getTailRisk", "fPFOLIOSPEC") S3method("getParams", "fPFOLIOSPEC") S3method("getAlpha", "fPFOLIOSPEC") S3method("getA", "fPFOLIOSPEC") S3method("getPortfolio", "fPFOLIOSPEC") S3method("getWeights", "fPFOLIOSPEC") S3method("getTargetReturn", "fPFOLIOSPEC") S3method("getTargetRisk", "fPFOLIOSPEC") S3method("getRiskFreeRate", "fPFOLIOSPEC") S3method("getNFrontierPoints", "fPFOLIOSPEC") S3method("getStatus", "fPFOLIOSPEC") S3method("getOptim", "fPFOLIOSPEC") S3method("getSolver", "fPFOLIOSPEC") S3method("getObjective", "fPFOLIOSPEC") S3method("getOptions", "fPFOLIOSPEC") S3method("getControl", "fPFOLIOSPEC") S3method("getTrace", "fPFOLIOSPEC") S3method("getMessages", "fPFOLIOSPEC") S3method("getWindows", "fPFOLIOBACKTEST") S3method("getWindowsFun", "fPFOLIOBACKTEST") S3method("getWindowsParams", "fPFOLIOBACKTEST") S3method("getWindowsHorizon", "fPFOLIOBACKTEST") S3method("getSmoother", "fPFOLIOBACKTEST") S3method("getSmootherFun", "fPFOLIOBACKTEST") S3method("getSmootherParams", "fPFOLIOBACKTEST") S3method("getSmootherLambda", "fPFOLIOBACKTEST") S3method("getSmootherDoubleSmoothing", "fPFOLIOBACKTEST") S3method("getSmootherInitialWeights", "fPFOLIOBACKTEST") S3method("getSmootherSkip", "fPFOLIOBACKTEST") S3method("getStrategy", "fPFOLIOBACKTEST") S3method("getStrategyFun", "fPFOLIOBACKTEST") S3method("getStrategyParams", "fPFOLIOBACKTEST") S3method("getMessages", "fPFOLIOBACKTEST") fPortfolio/ChangeLog0000644000175100001440000003104213202401303014151 0ustar hornikusers ChangeLog Package fPortfolio 2015-05-13 wuertz * New function pfolioCVaRoptim added. Computes CVaR along mean-CVaR optimization approach. 2014-09-30 tsetz * Final version compatible to books and other packages. 2014-09-22 tsetz * ChangeLog, DESCRIPTION: Updated ChangeLog and DESCRIPTION files after submission to CRAN. 2014-03-26 wuertz * fPortfolioBacktest Package functions from r-forge embedded 2011-02-10 chalabi * DESCRIPTION: updated DESC file * inst/doc/PortfolioOptimizationSample.pdf: removed pdf file because new version can be found on the website 2011-02-01 chalabi * R/efficientPortfolio.R, inst/unitTests/runit.minriskPortfolio.R: Modified returned value of targetRiskFun when the target return is not feasible with the given constraints. 2010-10-26 chalabi * NAMESPACE: updated NAMESPACE 2010-07-23 chalabi * inst/DocCopying.pdf: removed DocCopying.pdf license is already specified in DESCRIPTION file * DESCRIPTION: moved Rglp and quadprog in Imports DESCR file 2010-04-22 chalabi * DESCRIPTION: updated DESC file * inst/CITATION: updated CITATION file 2010-04-16 chalabi * ChangeLog, DESCRIPTION: DESC and Changelog * R/solveRquadprog.R: set weights to NA when there is no solution 2010-04-13 chalabi * R/solveRquadprog.R: updated for latest version of quadprog 2010-04-12 chalabi * CITATION, DESCRIPTION, inst/CITATION: updated CITATION file * R/solveRquadprog.R: Using solve.QP rather than calling directly Fortran routine in quadprog pkg. 2009-09-30 chalabi * inst/doc, inst/doc/PortfolioOptimizationSample.pdf: added pdf files in inst/doc * DESCRIPTION: updated version number + link to ebooks 2009-09-28 chalabi * DESCRIPTION: updated version number * ChangeLog, DESCRIPTION: updated DESCR and ChangeLog 2009-09-24 stefan7th * R/efficientPortfolio.R: committed all minor local changes * NAMESPACE: new NAMESPACE structure which should ease maintenance of packages. 2009-06-25 chalabi * DESCRIPTION, NAMESPACE: Merge branch 'devel-timeSeries' Conflicts: pkg/timeSeries/R/base-Extract.R pkg/timeSeries/R/timeSeries.R 2009-05-26 wuertz * inst/PortfolioOptimizationSample.pdf: 2009-05-08 chalabi * DESCRIPTION, NAMESPACE, R/builtin-Rglpk.R, R/covEstimator.R, R/solveRglpk.R, R/zzz.R, src: reverted Rglpk C files * man/frontierPlot.Rd, man/getPortfolio.Rd, man/getSpec.Rd, man/getVal.Rd: updated manual pages 2009-05-07 wuertz * R/solveRquadprog.R: printing of warning removed, we have to find for this a practicle solution ... 2009-05-06 wuertz * R/solveRquadprog.R: prints now warning when solver Rquadprog does not end with status 0, but still continues operations ... * R/frontierPlot.R: new argument added return = c("mean", "mu") to function tailoredFrontierPlot(), not checked for the ebook. * CITATION: CITATION file added, eBook Portfilio Optimization * R/frontierPlot.R: bug fixed in plot routines, only happened when risk free rate was > 0 2009-04-29 wuertz * R/covEstimator.R: rmt estimator added * NAMESPACE: NAMESPACE all functions exported * DESCRIPTION: DESSCRIPTION modified * R/builtin-Rglpk.R, R/solveRglpk.R, R/solveRsymphony.R, R/zzz.R: Rglpk builtin added * man/solveRsymphony.Rd: symphony deleted * src, src/Rglpk.h, src/Rglpk_initialize.c, src/Rglpk_read_file.c, src/Rglpk_solve.c, src/glpapi.h, src/glpapi01.c, src/glpapi02.c, src/glpapi03.c, src/glpapi04.c, src/glpapi05.c, src/glpapi06.c, src/glpapi07.c, src/glpapi08.c, src/glpapi09.c, src/glpapi10.c, src/glpapi11.c, src/glpapi12.c, src/glpapi13.c, src/glpapi14.c, src/glpapi15.c, src/glpapi16.c, src/glpapi17.c, src/glpapi18.c, src/glpapi19.c, src/glpapi20.c, src/glpapi21.c, src/glpavl.c, src/glpavl.h, src/glpbfd.c, src/glpbfd.h, src/glpbfx.c, src/glpbfx.h, src/glpcpx.c, src/glpcpx.h, src/glpdmp.c, src/glpdmp.h, src/glpdmx.c, src/glpfhv.c, src/glpfhv.h, src/glpgmp.c, src/glpgmp.h, src/glphbm.c, src/glphbm.h, src/glpini.h, src/glpini01.c, src/glpini02.c, src/glpios.h, src/glpios01.c, src/glpios02.c, src/glpios03.c, src/glpios04.c, src/glpios05.c, src/glpios06.c, src/glpios07.c, src/glpios08.c, src/glpios09.c, src/glpios10.c, src/glpipm.c, src/glpipm.h, src/glpipp.h, src/glpipp01.c, src/glpipp02.c, src/glpk.h, src/glplib.h, src/glplib01.c, src/glplib02.c, src/glplib03.c, src/glplib04.c, src/glplib05.c, src/glplib06.c, src/glplib07.c, src/glplib08.c, src/glplib09.c, src/glplib10.c, src/glplib11.c, src/glplib12.c, src/glplpf.c, src/glplpf.h, src/glplpp.h, src/glplpp01.c, src/glplpp02.c, src/glplpx01.c, src/glplpx02.c, src/glplpx03.c, src/glplpx04.c, src/glplpx05.c, src/glpluf.c, src/glpluf.h, src/glplux.c, src/glplux.h, src/glpmat.c, src/glpmat.h, src/glpmpl.h, src/glpmpl01.c, src/glpmpl02.c, src/glpmpl03.c, src/glpmpl04.c, src/glpmpl05.c, src/glpmpl06.c, src/glpmps.h, src/glpmps01.c, src/glpmps02.c, src/glpnet.h, src/glpnet01.c, src/glpnet02.c, src/glpnet03.c, src/glpnet04.c, src/glpnet05.c, src/glpnet06.c, src/glpnet07.c, src/glpqmd.c, src/glpqmd.h, src/glprgr.c, src/glprgr.h, src/glprng.h, src/glprng01.c, src/glprng02.c, src/glpscf.c, src/glpscf.h, src/glpscg.c, src/glpscg.h, src/glpscl.c, src/glpscl.h, src/glpsds.c, src/glpspm.c, src/glpspm.h, src/glpspx.h, src/glpspx01.c, src/glpspx02.c, src/glpsql.c, src/glpsql.h, src/glpssx.h, src/glpssx01.c, src/glpssx02.c, src/glpstd.h, src/glptsp.c, src/glptsp.h: Rglpk C files * R/solveRglpk.R, R/solveRquadprog.R, R/solveRshortExact.R, R/solveRsymphony.R: small solver updates * R/covEstimator.R: more cov estimators added, student, bagged, bayesStein and ledoitWolf, currently for internal use only 2009-04-19 chalabi * DESCRIPTION: added explicit version number in Depends field for key packages 2009-04-17 wuertz * R/solveRglpk.R: Problems with Rglpk solver now solved. * R/portfolioSpec.R: New internal function .checkSpec() introduced. Stops execution when we have specified a linear solver forgot that we have still a quadratic programming problem. Not yet all cases to be checked are already implemented. * R/methods-show.R: A bug introduced when printing option introduced for n (=5) lines, has been removed. * R/efficientPortfolio.R: The compution of the portfolio now stops and returns an error if the minrisk and/or maxratio portfolios do not exist. 2009-04-04 chalabi * NAMESPACE, R/covEstimator.R, R/efficientPortfolio.R, R/feasiblePortfolio.R, R/portfolioConstraints.R, R/portfolioData.R, R/portfolioFrontier.R, R/portfolioRisk.R, R/solveRglpk.R, R/solveRquadprog.R, R/solveRshortExact.R, R/solveRsymphony.R, R/solveTwoAssets.R: improved speed of some key functions 2009-04-03 chalabi * R/methods-show.R, R/zzz.R: added 'length.print' in Rmetrics global envir. It is used in show method. 2009-04-03 wuertz * R/methods-show.R: prepared for subset printing 2009-04-02 chalabi * DESCRIPTION: more explicit depends and suggests field in DESC file. * DESCRIPTION: updated DESC file 2009-03-31 chalabi * DESCRIPTION: update R version to 2.7.0 in DESC file because Rglpk depends (>= 2.7.0) 2009-03-13 chalabi * R/getDefault.R: removed already present method getModel 2009-02-10 wuertz * R/getPortfolioVal.R: getPortfolioVal committed * man/dataSets.Rd: empty \details removed * man/00fPortfolio-package.Rd, man/class-fPFOLIOCON.Rd, man/class-fPFOLIOSPEC.Rd, man/class-fPFOLIOVAL.Rd, man/covEstimator.Rd, man/dataSets.Rd, man/efficientPortfolio.Rd, man/feasiblePortfolio.Rd, man/frontierPlot.Rd, man/frontierPoints.Rd, man/getData.Rd, man/getDefault.Rd, man/getPortfolio.Rd, man/getSpec.Rd, man/portfolioConstraints.Rd, man/portfolioFrontier.Rd, man/portfolioRisk.Rd, man/portfolioSpec.Rd, man/weightsLinePlot.Rd, man/weightsPie.Rd, man/weightsPlot.Rd: man pages improved 2009-02-09 wuertz * R/getPortfolio.R, inst/unitTests/runit.weightsPie.R, man/getDefault.Rd, man/setSpec.Rd, man/solveRglpk.Rd, man/solveRquadprog.Rd, man/solveRshortExact.Rd, man/solveRsymphony.Rd, man/weightsPlot.Rd, man/weightsSlider.Rd: more docu minor modifications * NAMESPACE, R/efficientPortfolio.R, R/feasiblePortfolio.R, R/frontierPlot.R, R/getData.R, R/getPortfolio.R, R/methods-show.R, R/portfolioConstraints.R, R/portfolioData.R, R/portfolioFrontier.R, R/portfolioRisk.R, R/portfolioSpec.R, R/weightsPie.R, man/00fPortfolio-package.Rd, man/class-fPFOLIOCON.Rd, man/class-fPFOLIODATA.Rd, man/class-fPFOLIOSPEC.Rd, man/class-fPORTFOLIO.Rd, man/covEstimator.Rd, man/efficientPortfolio.Rd, man/feasiblePortfolio.Rd, man/frontierPlot.Rd, man/frontierPlotControl.Rd, man/frontierPoints.Rd, man/getData.Rd, man/getDefault.Rd, man/getPortfolio.Rd, man/getSpec.Rd, man/methods-plot.Rd, man/methods-show.Rd, man/methods-summary.Rd, man/portfolioConstraints.Rd, man/portfolioData.Rd, man/portfolioFrontier.Rd, man/portfolioRisk.Rd, man/portfolioRolling.Rd, man/portfolioSpec.Rd, man/setSpec.Rd, man/solveRglpk.Rd, man/solveRquadprog.Rd, man/solveRshortExact.Rd, man/solveRsymphony.Rd, man/weightsLinePlot.Rd, man/weightsPie.Rd, man/weightsPlot.Rd, man/weightsSlider.Rd: working on help pages, also some script files and code reorganized 2009-02-04 chalabi * R/portfolioConstraints.R: 2009-02-03 chalabi * man/solveRsymphony.Rd: fixed man pages Rsymphony with new Rdparse 2009-02-02 chalabi * DESCRIPTION, NAMESPACE, R/solveRsymphony.R, man/solveRsymphony.Rd: added Rsymphony to fPortfolio 2009-01-30 wuertz * R/class-fPFOLIOVAL.R: new class for portffolio values on the frontier * NAMESPACE, R/class-fPORTFOLIO.R, R/feasiblePortfolio.R, R/frontierPlot.R, R/frontierPoints.R, R/getPortfolio.R, R/methods-show.R, R/portfolioFrontier.R, R/weightsPlot.R, man/weightsPie.Rd: many small but significant changes * R/getPortfolio.R, R/methods-show.R: get / set functions checked, print function for the free risk rate fixed 2009-01-29 wuertz * R/getData.R, R/getDefault.R, R/getPortfolio.R, R/getSpec.R, R/methods-show.R, R/portfolioSpec.R, man/getSpec.Rd, man/portfolioSpec.Rd: not yet implemented set and get functions added 2009-01-28 chalabi * R/frontierPlot.R: changed tailoredFrontierPlot to avoid warnings 2009-01-26 chalabi * data/GCCINDEX.RET.rda, data/GCCINDEX.rda, data/LPP2005.RET.rda, data/LPP2005.rda, data/SMALLCAP.RET.rda, data/SMALLCAP.rda, data/SPISECTOR.RET.rda, data/SPISECTOR.rda, data/SWX.RET.rda, data/SWX.rda: removed user name in documetation slot of timeSeries data 2009-01-26 wuertz * R/class-fPORTFOLIO.R, R/feasiblePortfolio.R, R/frontierPlot.R, R/getPortfolio.R, man/portfolioSpec.Rd: fPORTFOLIO class representation modified for the slots data, spec, and constraints 2009-01-25 wuertz * R/methods-show.R: * R/methods-show.R: print function extended to non-linear constraints * R/methods-show.R, R/portfolioData.R: rownames colnames added * R/methods-show.R: names added to print function * R/methods-show.R: print function extended 2009-01-24 wuertz * R/methods-show.R, R/portfolioSpec.R: print functions for portfolio spec improved * R/efficientPortfolio.R: Comment added * R/efficientPortfolio.R, man/efficientPortfolio.Rd: example modified 2009-01-23 wuertz * R/setSpec.R: some checks added * R/portfolioConstraints.R: missing target return specified to NA * R/methods-show.R: rownames added to print method 2009-01-20 chalabi * data/GCCINDEX.RET.rda, data/GCCINDEX.rda, data/LPP2005.RET.rda, data/LPP2005.rda, data/SMALLCAP.RET.rda, data/SMALLCAP.rda, data/SPISECTOR.RET.rda, data/SPISECTOR.rda, data/SWX.RET.rda, data/SWX.rda: datasets as they used to be generated in old zzz.R file 2009-01-20 wuertz * data/GCCINDEX.RET.rda, data/GCCINDEX.rda, data/LPP2005.RET.rda, data/SPISECTOR.rda, data/SWX.RET.rda, data/SWX.rda: I put for the moment the data back to fPortfolio, still missing are SPISECTOR.RET and LPP2005. so we have not to build and load every time the whole bundle, when we have a small error in the packages. And the person who uses fPortfolio standalone has also the data. we should build the bundle at the very end identical with the packages in CRAN/R-forge. 2009-01-16 chalabi * data/SMALLCAP.RET.rda: added timeSeries data * NAMESPACE, R/zzz.R, data/GCCINDEX.DF.CSV, data/LPP2005.RET.DF.CSV, data/SMALLCAP.RET.DF.CSV, data/SPISECTOR.DF.CSV, data/SWX.DF.CSV, man/00fPortfolio-package.Rd, man/solveRglpk.Rd, man/solveRquadprog.Rd, man/solveRshortExact.Rd: fixed warning with new Rd parser and changes data set form csv to timeSeries format 2009-01-12 wuertz * R/efficientPortfolio.R: title modified fPortfolio/data/0000755000175100001440000000000013630677272013341 5ustar hornikusersfPortfolio/data/SMALLCAP.RET.rda0000644000175100001440000002364213630677273015666 0ustar hornikuserszWSMwhŊIQl6 Q@JS" EEHM]z/ޑ""H  1s^OrN2;s /J  BSBMa0a8yTGM ZzY<i1 o1t:>ڮya?IPPz8]IωGrL&5u?Y:ڟ h6ߝjp&Lכkbao`# nˎCc-ެ9am1>Oyl*X2΁㲆G9w73}nxuD@KXI Va4&ar^0]s_&\1a'/Hb˪;Wtk"=/Lk|ay/< +dElJZbr/=͌nԻv{dt!_ђ?9gdZ@9\ |6co1Vu*Bpَ)U%u,?qH Qp;rg@H16i8 WNQ w>/.7jhuR]JH࿼/^|%>lw~Ax|6~4Ż_Wk 1ݰKi] ;?q]x'M] {X\x\UrNݕgѪVpVaAo&O_^.K%^+jn),O",pq;lTJz^f&`,:"`ixK٬ () [Z-sK(~IT?Yd$/= FմbtD삄m7z"d"ח^%7bQSD*&H/;wΠb .ԆބSмCx Hh( ={v~dv(Y/GnPqU)0w^XG3z :E]]=Ƒ\B f!`@ nPR01r*(:A y JeG#nA6?9+,j LdK? c(8(5&6OEfCO1 c͉?MZayY{ǥRnR%lMc(5ZLd߾ Sethߠo*}_ɠ69ªn#<\3F>Lz~5l^i>2fs~ a87WiM|s? 2o0ƼgU#z@FKL~./ńv-SN! CȰ7 @EJ;3"d&nczbi{d;BGoKު)oxlqtDk[ }X7+=RRįS&nzAܶ.71[BS?K=? A\v.{& ֜%+6JbO2p opUAW** $k}"hglH^ 2ݟvauz*>uD 3;$iG-(!ƨv,t z*|P2Og; [> C<ԖI.O-)'|+/Õ@ BY% 7\8iqjUIAf^ Yׁ9L}Dht@ppc6~7٩JXڱYxzc#)NXj퇭#йPa .:!XE:GOdF4։>&.VS{S\~UE`Ԓ7>Ⓩ9wwA,,=wMzDND}Vװy!k&3XY X^E66Kѳnp1v)Fl^a(#tI/)0﷙ 距CMC2{gr`|Rf֜9D%^R$z2j(7 CkڥqehVUV Eƭ}*!i K-yx}\GcEW@ԞYNx)#%bkT2!FP/Ht7ӂD&pJ͒->XsלQde{ԥ7 RϙEP,Kr[8B;Ҁ%3֚1ó.pgH@OñaGG>.*X_dY[E+ĦuY|+Eb[ vÿ\;F{l">`[k&aEUcԡ&de ěf Cq

2bVB,xh,xkT8FRJ:IsY!=4N ٛ6J٪o͒_aej!LSmJ0hڭJÝ*i; c'P{H'XEl50R@ISzmCS宾6U$MdH@LPOqnY8Owqj-օ/yPni wGPlhg({)BU/z _b$Oǟ__XĖ)]jxG*r1J왥;!?1wԕ dK%10;>cFPr~@܌\i3M ~Sߍ@weMQXR'ߤucK:X;NY7GY°7QCN>=T>b+4g3s\N<΍1nexBҷcg5P5CX <̽gpnlmV|e΂S@uZ%yI'5aZww TV@~OC6a|Mr}snFyv]Vp0CgVufVY F~,qZKqVpޝ!{Lxh{o<=.,$p'`$RLW+=ɡa10U. UhK8E{ &CIN FƞzhVNaQq5A GaG4 < ? Z7CyV1'+b!d.K_#? =z?a]6@ֲS8FkR<4ZAqmڼKC}[P'g3lHJǭ*[Òm&/&t ] "ȃ4L"sYjHǃǏJ\&n9n$'-Cs6/T͢D=-RWV?;uy}q{Lޮ ϛ{2@,#PԓZpe9,I{Bs`mHZϓDlyC>ќ7Au(l_uq<-Nv+}. V#OY0i&Z+SQ+uRZ(&.[-p#vؙ`̓4DaS$tֲ7/VDf[uԡ C*Bѕ)n.}2?n} h#%#cθw%|^3D<,|{,gbOPx>OQvH[r >3Y c,LJp6D]CF D }YJ$~ ,i34I^̠lc!s57 ˚ɦ«w'W .BX|QX4[?~`QC"Y` >Y ہz.t}qv ޛ>j~o0buŧ@pq%!2"k v rgj1cqL~,QTgx:4ѵfq̰A-(VٹH_l!j!0i$`VZ (It 9!ޝY3φ!E{6T Ilk f1qrnO; 1Pfs-n>3diCh /W!=A'1~>|QBPcx+W5 S4õ!r27ߦZ yJwpiMpSD\h> mzrV"צ{f{}׳CzE0p>*L~Jך2i[X~'߯g6)bOZb롄&Wd{uA~nr /r?CtlP`g7'q;#~#.'L xg䑻3g~fDgm/H}a h{A9=-ʪ#Xv{en]엄=q@R+zw6Thڡ7`y ~ '׷1vRn7o\_:B'0opK %~{y4&Dr"T6|\8&/M9~ SZoup_sХyz;TfUd.soS'>/>'5l px{>AX+C!O~"C u5hȡE`ld.8nwTKNDX* ~ÔX>5,(S;-s0)ֽo+OKuCH7Bg~yM h pN7BQ~k̻0 bT罃(Oà \M% ^fp:y\) y&!^W*wհsoX,rSO< ڤcL3ݺ~s<$GjR;h@[?qR07XV0ѥvx0| υNJʴqj94HGւT +)/@M[!;@،)ӔVu [D}XYGU<a"|<>YxnARhg–x ZdWs&Bq$q Mxq@6b8 ٬wx%s r;AԳg>ӹޯro#!:[A㔊R?{.W̄˜֘a.w2e,Cs%`9wc;ۣ0VPw ؙjXxI'h,S:(1U|&9քzo5)s4OQ{\#-wy(?:n.:W~3+3w(Wjlȵc|\qE"dAliNܕt{_,G^CCpRs y#@v!6{/DTu`Ȍ@.mH_y%xθd XPmR> ;vX>/|4j<.TBcCf/71_ry!>[e D_r5H D.E["IbnhH7^cйV^iDsF;D]Hq l`9ybL(uD R/~.Gs Z$kjHe;η,Fי۟b5Z|w >*-祒VNUMĂ'fcF,)?9׎e7|];T4wGvɖ1O4yPM=Uv. u0 liC Oc[)M+^V]?;$Z$ؔ t?`3mM0Xjփ']ybN^QիvV'/FWށ#:`9yCn^? 3iMb:gj~)-;:pae`Sb d۩9`mc5QL?Ƅfo-?6c,ۘ9l4TTԷ:.UO_-zpׁ`"l6[( ELp8Dފ ^GpWCI97CV޲4^j ֐eeV_Sdnޖk9nBp!na`>X[h9oc7( &Wk#Boz#:t8#7Law?SOhdej7ޞǟ_!w.oΡ]&T=Қ[SоGvN4uu&&kh::ީ9ԛlԶo$w]*><НX^ I'{LsRgbEu䷧hқVIᢙߗe%;3{KۛY٘FBFqS,-_Z5NK Mۯ]Dѵ<>^<귘G9/Q;?iu4^__:-27£L޼kidg2DMَ-bofoi\=3+SQS[3S;!csӳ\:`5~FeLIFIIJʪ*)Iv$c~¼sFg-%/fPortfolio/data/GCCINDEX.RET.rda0000644000175100001440000014212413630677273015653 0ustar hornikusers7zXZi"6!X8])TW"nRʟoÞut65rϫcН31M"38OrCGٟ2fd*քJrt*uojV2j>0.U]Ү / V+>$cM+GpCmVl, W69,f0`AH{n R7CM09O8P |`I@wr( ́K2+|p@̶:X$]9a'&-PK}Y?:TAR`+Sr֞; r8D翆ZHJG!yDv"e!i~&H( X{|ly=< ѣ#SlJ+x~Shܺjh 9乃") }i(ٽ/,}СcfUa.%=wN05rOY2{ĸa%^ӆ`|6w2seK-,q)wpKD}%SY>S]&z n/NK-56Z, b6J:@(ԊdΘ]b5<]IyH~#dE6kW4y%e{|:dո/V-X$<~Rjd!Z†VNn.P|I"͝L1BU9Ftw/٫u= >97 E>|(}[b> `zh XIbs5Z1 @ ܷ>{'ZX]<cABpYڜ;[Dg/6Լj%_>dF.!a[߮ng#>2(7FVpa<]o4}?Ж7r{;B'>c<2 (Cc%άrd2u)uLn VE:";Bգv7J{ sKu3c%qymoGus'13Dp4j$)0  "257E]*;(ONwKgكϨ7-* ז:z$%L](:/lv'+d)/SH2l`#?.83-Mi&q:2]ũ.eg)#}fy5!FM?陭<"_6GȠ90VC] u7+`dkV߈Y0,`<7 ]6cQ<٘  O]ͰAXgW骈Rv8;`B fuUئ"|O{ARK0~ Ì ݫ/5}4imdKxcG0bX; o='Qm)5KHT)B+32)LHj-g(cDJ${]nӸ{]6 SOgT40 7yDWsʘ{ ٴxs+4X6L. 9 Un >uU`pCahXv{,+)9>GIPRNgWMqtn3YiQ/}Urh{@h,/K2wRa"D0FOIʘ8F/f2ޒ-ngv'a ߻_\$4c`:c YHyO6+X’\&A.4~0jۅVAP"5gʠU山 1Q/ d ѩ8E>ώT@lZxqA:i m8[UA cmI0`Om,Gkmo!4(-"-NvGʴ`+E~e8uCEK:%鵄')7 J /sͅ:qIR~fb$X7oQƀH-#`~$9qci.A߲z1Q& Sblj N&/FgC[ngj3k*O$:4 DYK?+{B^A< }p%3غ1*ޥ>/v'3(| XoՕ=.\9x2)[|iH"2A_{,1\Bbx([2l1go>ceuz?wlpȝ$SC{ ;m{zkZx<>qśTNpKV$`g])s>'ILw i'5V$>.2ݒ-m=Dd$D^At@M}E۳pFX-iMʆCjfTv\5׉' cvZ=ݧ@ t_dmG(s7hVa-j"Br%c 4wz~4U\\Ԉh}Y<`] u'7'M };BsosSqaЯY<9YW~U`h%-io'T/NMȖj|;(.=壿-+*FSRԽ̿+ãt`Tף ɔχVx ?-B2T qG=V}8Qe)J""(@Dr(3:Kf/LYG/)wF'xN [l2LY$"'yY}U"f"Tď@O`GdSQR|Q/b+ӓFajywW5G¶V6>ם^SWT-=&q˳K^e]WMt|?cE?ėz Ib<[1}p?_b$yw [#;G勘/+!>ۄރSǢ!L5VrepK.q@H3q?q1@ xSTʑWuX7!i2 E uUv_P塌%֪Q-6PJxY$B)'8S_)>MӕBLƙR)] 9X5xV?\HϤ@K?Q^XɊ,L\InC&e_7 닿(aE].w9J2:*X>4ng*oc~6lq~aՒ>DLFrtB*i{Au &>5hL3d,?,rkp-qPz-X1u (ɂVi:UXxrO%s‘).&o%k@$@  bK$ ~W! S"wD vp΂f56.ݸ8 :?Yfi4K(Prҭ%E=R8|Vlٝ_*h5tRuy!W ÝaDZ:`:Bna yDގ7 fGGɚs&gr]O[?OWg%r=]g87Hhhp끸7ycB䧗1fx$2=kqYߊUJ#z.r4FZXN蠹աh x4i:,[ h. ̀:o^n Q+`|ǒWWxx# UZ]9`u(T:~30.B-vQ~y^Ƴ(2U0O$c3hpgQrYꠧl޼ G2>X\Ó/n9%T3kqs5&seM1MQd&1Q7KbZs?&?ĈK"c[Qhi IUx@`&ꍢv>)_`Wl~:UX8eXZ}9-|vv#W# lJSwRu}Eom+ MdضaR$cjܲ;Zm&dVb}I{?xi?j9 UBUXg&gY9Fz^sZ:{RaS ΑH&$}m B"47Et<!Nan3JYpj 0/TxY }Y<*(9(@h[e|^&;P+U+i/ i70ga'jA8-γY)ftKP%*'OM4/d01^ӄ:n$ kڣK3LoYFZ~ci%*G](tQs.$4j tj=eAJS. kGYh5v+C40Yb9:\2gxohjӚ?\6}<} ]A8)'I꭫}FvO SsQP|H %)2Dhh'uY t7ۭw n9*e\mVYGX>VQ680]c9gDnS$C*J#")] |(e+jmsJ;0y;:&1Gxkg˙MV [tTUҞςDG&Vނpz]2&*=,9` b8V͔1ʼZGL>+gb8;ف\rd:嵏xld"ª}З1@ԋN.)Zfp$Y?;>҃groke}+:" ێZT]̕h̴B3uf1Bagg8 l R`Tj,WwZ7{c%?6zeXR8CWwGԔNVSCR7%poo ͻІ)fԨ :PaͯKt/3q6O{ihH_%`K AqF8.w8]J"1xk)@z988~t%Q=gQ2 *;l&\. a`tQ f{mnM]FeBܚ_; 2PZ}x|+W9tX-**8gXj>&G)ޚg@*^7L39u28ޛSCbPzb CcYѱojB*ΣΥ>XoQdƉ@{GWEܡ:  {q7#'tqz0dp!B7rX 3EWqg`#W TLSo%zTk]$$ E\LyJ+p?QOvrh,x%!{Zv%_(?qPhp+J6; 87:Vi%$Ϭ}i7sZ7tVcy)]yB!Uƽ:)> Aʉ" >+ޱ=qE\BmѽIDN-m31 ) lt]VyuYZQFYȈ /™5#}qD4:++&|nˑ!Qo΍=1R4ìRC l_Rw` bw }R}]![W0+C)*22 y'Ox#j/#)~3W"Ip~*F E߁5$rlwF{l)]WeL,@t9hI(CݤiZFny$Ŧm_ #U݌DIC O y׺tgb)XB\@\))܅#7t0]msN4͵G[b@EB]  4Pj܆%bǍԭVQS؟Qxξл}9nr2" 5ݘWg p.;Yd%Po%/6(j t`' FCcB3V_,KM4m%=z`o݀zޙ8A%ۅ#RFWgWVkHzlB-y3{r՞ov5gʱ&!nۋd6Nln(;[I" Wm?sZ?gzCH@N 6/5dy8fi'pL^/ӍP"e41&[x.%sm0 sh[U  Qz\/`2>xD$V;Oxx=_I<330)V,j`gzW΅m\Uq,Oq'17ʣ8wݠTX +6%%ۃz?~.DOZ9k5֊ V6 &X+ؠ:Ϧˉ=VrRSQ̦yQszY;̎^P8T3G .WM(8CroYAsgCΕoKBٴ9 Jȣ waw27i|]%: OtF7S.ZŲ V)K؏j CW.>nU%|6"2>*fZˁ?SC.#/RWH?b0(%3.ziڮGu"?%* H[j ~Y&/gYmC;frXÔC{lL!)C1B:I{,Am/.#8HxokqSWcj2OF!G'M8S WOy +N =rx ';S[~J;:֚ <_u4waA-HokF xHWwTУi |.~6h%饏Qmr5!~ús[]X{J75IcT[`|HqQOQ^*QXT:P1 @VtJb8{Iu2*d}Uh!@·6_,Foĥ$sN>gX_G`Yh  x%=$r+m|#`)~ꄕbԨVZ)fЄ*U{$|inGaNLQ.~*n3`-KqOL =$ٜ/[fv޼OEaREjkW"ibhZȜL f2E Ju\ϊJUݚm1`mߢiZTǼV_h1jtQnPU1ki4@ ]6S8TnP wnа;Jޣl:du@kC \|[x@$#b1{%G0F[WWx¦c?;W$&0{UA<CX5H/}l̳' X|DăY䏃<ρjc%OBޒ'j qT۸^-qrL<iZ1eN hDOjK) Ӻ^UeƔ}XMF7ة,4`k-ْK4*݃B/ZLL% l*G炢z7rjN@vӪ/{3|D.v9䤵D!&͙3zH.iS̳k_|^qP)󈡏[jwa}4G/^›jx|ȦΔϷǮXh tRDW+^(-C򚝚ė M_5Z~atЃ50{S겧tWyk`TWLJ¡*g34kD{6q6=dUf1k"%~@~[E Bn9pP ;:e\+ԏG;]_2Ϧ_ܳ\JW B/1~$OІ0vPS͑h5P ќ VCֻӋ_TfMX*D,2=u2˶LUe\-۹_A-aE4! _?\e]Fb ax6gCdi3WhRy)̹/Rd$K% nf E2Ib H ~+50t+E7jµcprD`z8G0}-SPK 9-+x+;悞|ll8{I)_%츂l#RD0Èt Sq!qibڌj;IW˧;$~Rt]EMGbZa`ӟVL3mݚw5uQ*X1iDW/SrNjG~ mH@E%sh6mwUdSBe!_\ \vWfE\]f\Ul`|(.,}8"MhÂ)-ڍ^O0^hd6w1fXCaw'b3FjYWs?ic;i# ܔtp.%zA"4L*򩅚a@C] 0)*ӕNq `v LVaĻ*Cʋ^1؆n1unx zH i)5̟ٞ5 }=˅H^z 4X÷SǠb#6OI܀1:$N)hķ~%R=y9 Vur`(me4mD;S'FBXѲx,P^~MKkdҘP:*H.hzPm[/rD oA%xs`9.(3v8ANlOѭ"wH'h8^r8pFUB7kc8"-GT/eɆ)K+jNfA(?&>Zc3{@.0QٹA1kHKU_^w 嚧>oո.q=$u #B[9|`fІZ LjlV$ý5ŢCDG, )Jcsu-]t|*AG Mg?b"@o.,\QB5>jK0e5Ո4{<,+f]XX7Gc5/ڽCEcM[:Ӛ[7 rol PuD'eK+FJ$i~-):Mʂ# "y<@ ̢hQDHY2EbWe翹 ∋CF$ƀ0=.,NO~[bF a`xȾϻMuj p̺"V?NbGM=*h((6w9K8jL&KWR`x,;'Gu='ilzXqW:.;lm61=Bu5?iƣ,d|υ 5?<yM4Q"ͯ0CxN!y䱙 $%#G*In;s UE 7yBiǨ7 j}Ơ忓 nyV\qBcF(%ZǑa߮O /Aճy¹o us* }Gޗo߅Iۿ\(1z+ 8~ÌCpp7N8idow47댅)XEk)٭$Q^g.uz냈̈`H@Ï0G?gd+vr1/SpαT?}O^<\۫ "1QrjtlEH!~i$~\.[]ad6 SqYF+ᬛ\{&:~Bۏe #PD0֝T{BD];]*S07RHwisBGyWAr'g BJhEijbaUŴ8ogtQQ*m4*"ڼ߲XeUkNœB.=C1V+b+tBRǶ';."rx#6v]bʩ>X:%ލՁ$~C?Dgm7 :Usn!t_eAWtݟCD2W< 2o֕'%,<2 AY \ərAw2Fhm1E2i,HCO@3J)@"z֒'_w'[RԏFLAb`y[̐h?bYOdJ j_QѤ6 O5 䇴52)pͨ'WY+XSߗ ⵊ|ϚYuMysbka7Tr9M_]h(D&-r>/m;#G:ikqèֿSOy|/1bo*_# 8l%ZSq)Y"\J0O[@p C>`J .{_ksgxJ󔪯KSr*&yZ|'$4a- &"%-N.>FO{PvwQy>{b۾-&-&kG1{dxG{cї| +o@@ůg݇8 6!'ޏ64s^JDHj;  5;KKH}ltN1^Z2үZCY_pKz~ cݨϴŃ1zؗ8K%7LTXՐhFv4KviBTw NChZ qmZsβ_P ЙU&jXNw1X?4Ool $:͏aV$W+'pؗ$41$YߍWCd}<\^}޳X>{,lsFmR^@웬<% ;u1`}j%KN锘xNڹaٺUaaE xQ?Ȕ(eA$ ͕ϕ>z~5d| AͲo%4icxB<\^uPL*gOw):LoBa,mKVl$UuRѤT.T?7?V)›=" ߯Q0Z<79Ww [ +!ļI!묏J*|tE *IRhUm""C{eh ikfǒT yȴELSm%˽葉$i{sbT ~ڔ.U_0(-SЉH6Yt({;KYÇA.l u[1ij)C`yh86|"E*Q}͙'UB;uIERJ,~o*f~o~-};gm}Uy0.uwzjK6/FuZUD{ c;"yfZZ0 + xBܬu-Ev$ Bg#ȣW!W |N9{-00~rT /m@w ;%嫧g.)h%L,On1N`uѡ}sFzA,?9|r:K+KE0?VNv "@!c AbK@@W.Ow\|%b+虠e4?4ipHo+C斠<24yc22'_9pIU=5\גmgP\|Uz6<\ةg& <9-&m]dڵmaըS\Ŭ9ӡU9 b䟒+X߂5" )yc c24{Oǐ0)TۮAhaK%>:-@=6U}OpQjN-[XA8=X%^>\$UVs/wsR)=.;|Q>1#A|~yA  BUᡧ =LoEqۂ Bˤ%]9;rXPD ϑ!H`EW+AMIg'm3M]6']_ şq$¥1fl!^qu1J]bk,5ᓅ t RQcx nV!$w{F4s7*%ڏ8;/"b}5F&F㔭e%sek{hEH5>r'iWUP ]JH Y5u1vd[G)afe7RYT!71#Ow8NdkR\B1B&9hljC'k= ToHgP˗Fƍn0}yCZ^6V8+NВ >ZsKISB7 /Ὀq'=>X/p".]Ismt*VV4-WWXܠhʥMdv.ϓct[Y6`xvP;Ǜ[8v,6krbBFդ ͈ޡ5FɿLDOIfkbNfBW_fS^568-%2V/*GJ!~?_/RYq{\A$1xF \<).'_4Whw9o%.)Fңr-@;Ǽ,8τ֢! -{ V.YcPn uu?8<^9ܖ+1ɓ/y5sb}{|݋3}l(}N߽"Z ٨Ip!l$M;.SC5)Y 0 3CwrmYP4vHȬə{Y>p WGr aAvELb_ѡ@l5(mе, O{US^ɀ Δusz+\-#ʮNQD*Td/yn_ 8h20)5<W4EC5/ ^~;2 kú"`DG1"TI@J2E:*/g:4ss^ @s`ʺYaW3ldnU^sx-1H(uO—7Ϯ ]nM&J%,CӃ4ͧgՂW^ ~Ay(.떍ΫBU4B:f{kv[$F,;ZEӳ"##{/nth❏3Q62&ӗ9tzޫMwr-ړtt].Z\ro"崭eÖ@O -a@#a64T[R`J-d@*3^MZ&NZj "(ą43rK}x6B%y}0[ h>瑇snڄ{9#Q6wő*K#s bh7${_p~sOt;Kz~@ /ǰg NWZ}jwji tu+IQC}%ۖd욠˿"j}=Hۙ 86 <KsYE,Wy0{bV/x]-U2E&#ÞKf gl(ˌb4k:O(J׿&2`,G]AN(raw4DufS~nBp~d6 =+B[$:mkY]1 ~Q-3d>G# qߠG`-\qǂ !Iњ,-zuTAmL3~hN8W&`H7%mpjCIuӊPv^=­eG>Ds %;X:3Ȥ0 $/M"DJ̯hUjE{x|C#(Nb5@3*Vv?y z3`3Mͣ Z< Ҙ_b@*^\ Pr;n=Υzš>gXڡANe[hCuD wo5#O/V3 aZvp o#GFq Qp6:3WVɛUW1{) Ε%j=g U%y yJj޻ᗝa,wSDIr^A*\o!h r0{gf N>n+p% ~LXKQg5'ߡﰵzUO58Y`arqō!*g=mi'&%˻{IԨO~r5Z_ԖgG?H".!#<Yy THƧuɊX0BY*:?n 2(׭=_;YS֞d7[ZC糍tt7SņW?b,P0솉"6TSҺY:>> 2K_DP5i9m,xN {QBj;~hZZ_q1}CchuA=EO2cC|ˎy֑c2Ǣ ja1D wv ߖ7r/m6"m`]r,m/4IY%E&t|̐`O;~驢\~ѶP9솹F)/W,=G!lqKSteXKxPNy\Zu[wWBw?kIrϹHt. ߁&w?OѦ}U%[ 5$"\c.kŪhy@hk Ipϯqug->\+н$MR7~rc˵oxav76Yp9ּ ;A< }T̾GӮ&̚xM8lA0qHn.IS'1.n!w1$śio/N,}N>ѳUe_Wiأn#9G"ݨ}?5hZ+_r%^v2&v%8l6!Ȏɠr_L Ls-r^1axebjO6{X5-5q M .Շ_`CGF3GsŇnݪzA.,#QΛꮓyɚ53-Pj)h*p_uBkO9Pcy-m@bߡ)nph(oSXq?4VyiNoas\T6XWTggO]O VpI"^ tx"BM. 9&]k -OUU{.?ۛP9EH ZHכ`"&!t2'ѢikCX_г)Ԯjz`p*uˀN(2'ef5M*Q/[H]̱!jY(xQsQӡ4^iސ hj_ahz%'IrdpTXj.< F:-/E@~+Eݡ|!9.q;1Z/xqe;LS< B;g4,DD~ &iNܐgGm\GL eDpDkr#B]oP\,3F,@?<"3VןIayWf'!#hzÜZ>JC"`0 }t=# ~$a!! Eʷ b%-2r.u`u8+TKip*@8@;09385&P]$كz=Xw BKq"#f7e̫5i?N1h*P&{(=yA)۽9Աqg;x[Mm1[h0ryGA"գMv~uvX`|$S"E+q \(UD6}w-wC6F^IOwh`]T9-7*zIu—)ЊNDmNEGCoFdL4ȱYE3L&$?:X"ՙJ9C~yXzu-B i=JGP|tĀpo͛k:6(H?2~;Q@ ߇2DouggCX -g{iԻpKڨE;26x>H"EW!7>[~<|3=.9t/?ΰf<(݌>O7yNfNJi ^>l cderVNu;U;vFk0}<)qCfgRIcRNGҿFӢ7|9v@|iP~*4~@6[3 ,"H<73+⚞ b|WA`+m74E3Bm鷠/J.BqDpO\u 4pf%) Uf 3^bs}#@f* & BjhV~Ǣl-ӟabH{%D- E쬊93*'4TyL kb+~LQnj~FC,iL,2NRiI!o ؟@Pu @Ȯ]xt.XL>_{bkOP'ӏ't=pD)h9+؝Iq'W阩[93LS#<].e5%[chY?({B.\Y+1̜,$ cK,+wSh,v#)[DUӿMQ8zc{ NIIjճ݊:ZIpƥW2 8Ԃ | 8 2jsS 7rB?g<rB Vo3{S#KjgQv?1öXA+62 DΜ[8˅^7eNjJBlZ^/-GvRkJJyyo)Pb_ {-lՏqz0&}ZNVܽ&ka<'bv&LKHTY¼YZGO1@X^S,ryv=ĄT-K(jo/bI\Lhyp8]״Vs 0--݁I^RNcT@y&vjvY0_ۥ? ؍΃;<`e1H޸ֶVvX )r},TǦR/߸E(mİO QŅg S [%rTtqdt4ۍ)u2| uIX^BÐq\$H3xAGoB2{@%xG)paa` TGsxhХ/oX ؅ZAc>ɤA [0(,k _f?#qWvz좛)Qs+R$ e3C-mE,k"Fp6`2ӫ{41n63؈KHuB+ 7meF;o|_%B fϣ~򛴻SdZ[? Ԯ -GJakdyhn`\'1D7;Upy]t E+Pܥ<'Մ9$gV_<_KiRR418e&9(^2 {Py-Xw!>%ƼuWA.*U1sKn3 !ݞmeвۏKboIÐLz!UNKˮ|*/:VDψ%CbVфY!o4 nAR .#OtkzidרYV6x QoZȖexJ's 3R/ߍB"~3cFU^2QuKM兛)MÇHs{pL="d4.FCЕX" JԌ:ŸjdXrd2`&N@DWd!8d5&ZkqWQ=e?^({h[&J: .6l[aU/P DB4 63  +TJ hJAJY+h}͖FgGMg\dSȞ_{V[9')tCװ$oU"ϖ1T R#QJ 0Mlܡ|ˍh [jIX\Ubf:(?#!sbfNԹk[-ԷFejgR-% ALO0`RܻiDzx]pU\"M,Ccǰ_S/#/eoxk?)z}n'yUs3ފ xï3!Ps@ۮ*Ys !ݓhbk+쌯Nue.e)ld{ }q pD 3C[6: *W0w;W2}$D (6 >b֤xص-Kb~,Z!9eֱ,py%Xd"1@N8MכAzm W[HWrfѣew3^% A>7*xu _aw=> 1v292} -3>EG*II:^dUA%(AkTHHw@IH= /^+w5+*q"L=Ry\cr}BoʌB}5l5ws6W HJtViJaiŅ{Rɔ(T혿#M5d;d61ϮϨY}'pP+H/F4jϴğ+\ u*M'9c@`/ U,=9R7Y^cq_=]ߢZ.TQJ- r HUE0GVOg]Q{DrST: -HGY#kH'ڛbZV| v2w4x#LM~}mSj3KD?w- KeoO=`ig'˳gOL7lU%)P֦8%B4+*i(<|rG_8$y;U9:Y#@fc~f>0v }PhUtͶ8r于  m1lNWgfA鞧2+g$;EJb*wa]K#MZ> (gۄ}xJ-?d >~%N_F:s/]($qSm۬(T&[ i.' =_G@קfcpAFNˑ U?)wcrQr[ xŅnY۝*!*؏!6AsyQd)4hjw91BUPJgf>(xV\R]c*|!c6̟PKmqf{~kRoȔYde&nډerjI }X8,*q[ilU{M~3b7`Ƙ?U>el{X89Wb^Ab^ v= j53 '&]GVNJsu!HYWE2v0ϽLيr ^ȸA^*pf(]0y{+FLÞs%o %-W&!a\5!qPbw2AVo[I2RΗf= M ɸm~%xϫJF`&A\ϚK?6zèԥ*G@^k^J8CcDY_KB-he`BsÏ(n<2(\`d4m3#+9d^h%Y+1 s φOdg2aR/~R`bKBx믹E0_x <ȣnU=VV\,ʷ 7!/]-*\UC$Q+΂D.oWhQU._yt)\G)#D|C1G:t16R/ O<'@:=ӏLT7'J Ykۅ nb 32RأgZ?q@pb]][il*F"{F, V4s2PzNۭ^{ڃ&%&הAw)wI~K ~c&ɆAĠ'{6 Z`at!:9 rUDP#c[.X})DxpUksZ'\X8 huʟku LOn-~Wӵ@uЄw'5g. 2y}_"eS?ڊ$R6z~fN߲B?Bnf )FB!B8~؅BH@7c r1 qWâ_Tyor8| \jI<:6 G]SUOsD(wCN(z%v?`Ooz{s:T~ak"_&HS-ŴWx{h>]-2u3z 9v, VO3߳9L%j&FmxxlLc eX Y9OWulUqB6Eq:6N@_-*SZpf!~ 01JkH}MLׯPKPRE]źͳ/Vu"Q(aIR!JQ:y)o?\oɳǜ@G\jw+ӌJ|(jo;?r+}bRŭl3Bj?R .<ƣ84A8쪉5#4 NI _Z.EJcr~% aāV^'v{ j:wdb@~YƼ?&8װ,;좧 |}@.ĒޥɁiBT`+w3i 5!9ZHˀ]3 'Hʔ5@z[]M *g㔶LQ W?%t~zΉdp_%8l|8[ko&5+'5k:rOg9|:Ӎ ܫs)@?4`"졬@"I(:aaFc,9 [RCU `)Uat{@$Qg @>ĉw:T$΁ 9G7ĠW4u_H*}^mtYZuǴbdJ 3RHљi1; JȂHtCғ޹&#}٣Yl$̗`IC&dsz"u '>ՊfhApED&l%u)=2{qy ķOW|` {kӥy"3`BA[% ]![eDA?"dTl5_ ` -XIwD g +u4; *B#"+*6,N _'X 8f˝f"iYqK\?B8&=wǙ_ƨ{?yQiī׾Gz0.I%vH=<ΣOI0dS>DT>[nyr ș,u{"n1cDhW4Q׭/( Z'lg+w .9;"ȚvS]83xFxjy Zu;y)9Ο*-+Qksc@îaGS'4CvCBOw̆5l;@`!}8 lDM9tx*7`j1|kD 7yqMkNZ.IZnC/'8v ΍467'FEaj| H 0]@1.:`#c΀V|-F/l ͔:6ث#8M% 5iVC)nžKI-?˵ hAzoPe,w^DY./SoUMB7%u9H9{1y| ַ̾_-xDJ/j^r2%xi*&Q()X(|8@Z1ص<.D pYa?F:'̾yG^dy QJ a<85z~d+)aeUzfjĆ_l~$$Q|:=8Pl_xvAaD؅-|6u_. gQ)I r' ->!BD/J+q%ɚL]Qȱ5XBY:L]L^KVCzsa9b![p BNzO DOX~ͥ`Sm;O誐p Z'CDL͠zς-¡I6m!3sY$!/ 3 N}CB wYg`!kjcX}n:Sv[@?^ع2Bw\|4Ou8R1xlkBn{$FB_mMKw͋te-i{kǭ}Җx%Aܐce۵=҈Lziv[T١OɈ+ϕZ9JR$t4&w} o9ÚUc.F2xrWyyL$J]ְ̈(Nn\O+<7xpBު٢eo;|<(rfKN5XԹ6<'Rʜ۷Cw+6nW"*ڏ;4wNJD:zXdFm-8췽dw>:W>V| :M{Ho#C(_ m'+(CP ?*VmbwVDYs-`oѥ/ofzDX(v*)~0K>.DDt<8\!!N 0郺{ 'mbl_ ##)V2։k 7dQqlZKNMA /WŴa'Υ{\@OEY2qRk:FKr{>xPa/_-G=]b/nn;,' } ޺ 6߱Dg]Kk~9]RA \!Ќ^Rqh@? 8 Jƹ\FREU;!(У @K×A 2B ZC?V"l 4aqA<dHGdDobM {.c6ْd :mσ\a.`uwՓJU'VB 6%T`Q IBII J;ґf[[NoC)F1 (Ӈrp*Ԕ"Y.SQnq!} Zجg}.7/:dD/t&^*Л|r"Vo^*wB{9 ORh.֢㴔yWmx4 3g''{z7JvTQ s~Ę%oi2ebɋañi8/./oX_k a,V w>) iP]4Jor}r>q(>&6ѧGyv-1?~'{`>PU {-ڿREдUۑ˅ꢟev Bz0^qː֢ sDCvix滬7sm[Ǎ1 oho斫 1{peisvL%b~tYx苬BGen7.t!q{M9彑'?Nޘvfle42IG\zꄫ Vu.&"B-\F:}}̄@'V\!EbsARH:1CS>S+.V6AE~iy-Bev~h4JWc=,{t [~ wT>UbIM")ۯ3S#Mp"[}^05d+tE J B*5[{0 XCMC(!I+͔t(ׄۘT; ;Xx ꢭH93eq׌<BvSdt!yJEHcsK7y⭐_9$< n:~jKn54+71YY F x^t'@,zاBHpbkȨ z԰Rқ/agKAasJw(y8sC 2T=_ CVjPv/ѷD χp&^!Sˎ۬-;#2"xfG4D"#['a> ф'ClصL!{tD6([BAniT* M糢 8+fdмB7]%O 7TMΪخ!>;|ų(kg?\*0`LJ)\?; |' wީ6D>ER=Q pV*ڄW]9 ]1.zdAR,b]\v݊gyB ®MX癮L:q/GNfY ad+EЊrV18 ]LK9uԔDLP5Vd9Y'\]3[^(ovT?i:ihTʸ[\XXx2@L gGmz4gɡGcj̃Y3}Ew(9=@dh¡d&4Kk6LQߢs7RRDia .\|t=p zFƶx*˅q`.]=W|cы2{ SzeQI2n0п)v76~3+ܐ&ބS yWxB`\ =~bs/_sP ?7@%|E6~][ 05Y[Ï4slT@M\ш=?f4ك}V Mcǯb:>H@hv/SăX쵘KɍNPk~i ]>.3EԦxEcDG;ܫ=B| %I?&@=ϼ%ŗ ͼSwϣS\E^ryGx1 (H ']; n'!KHke+(!\d~r );P>-縹e,){|G@4  c-7U:L161Ocр;m:sV1g9O\]lbî&Q98@C2+O\7ep\ K(<{! FU, [ǀY)%)* BBO8oN9\~"UJ#'y{vuC f]_QF',?BJw,\IVj 'rC(7FwO_hrޕi2lџEG"g8<[@r &jnY'TNK]DwiFƃ̽RT.\YڌQ(삋Ð̥x>&|RnYdLc0O[#jw\8ڐf}.:M罥 U^#>xOYq,4x'Q V+qa{x1Mo^-3^8X}!UM%V]ҪP\8C p" Y)$:w /m11'NTe$?=E`x%{^1*~3p_Qz@%fs=\++E/ S>>D)BDDhǠFߐ*wVtT53@n=.PǛHQYLJwZnEg&V\\N nO2&2ek/ՈÎΰ!ɡږPp8fV0UN뼊elѕ-/Ҵk8@EFSb٬Df"$?W`.|zp dQ>}XY%wS`C,Ovz G'^aK3g!\mANs "n!8pX U񛓳Cόj sX^͟2Bsz@1 Ӥ'VћRȄQH7G39-+,* ,(/{Arhhg տªbdzAwA^+u[^ fu } ?,(#'wҎ4'z}injik@jK>\Oy %^"+P3]gotmVE1&GφHg̰"'% ya<|3 ȥWz&|Z貲.G{+g/} ^Ϟm›%&-EkaIyRS Y\ Z!(! ?GMHSdST9|XL֔vF32".9NEq ^ /UC/9z2)C|1FXkXH4Q N^'͵Y]RBF_VIx6o/; ^bİH7@6g YaN bżL;xwY;\̽1MʆuXM7hypa#B! ~ŗF(z@P h! =1i9 1=6[izDB|q tB&mc?RR"5et&!鴺oE `ԙPh H{oR J'!M+ZƢ+؅R9ڔ&=eQud8JB `4;6I?[ܞcx!UPj8 SҸLcX(n"Dݰ߮p ț /Ǹ7: f?/+;.Lgg4%f(D,>K˙ȑߗ!qԤ0z/'9YޖG+ Q]$j!ڧ$mI~3[}Yա f<v+P +mϤcl2tZ{Fֱ eʪ4>n5O0F&Y`*9b9B`N%SѨtBՠ_'%rtZbX7 ISzD0QѪ]J',o%Av8C7/P|),T1u=h"N{ᙰpzD&td>N쬡{odcpPŭydP/aۃ+޷9F80] Gq }giRmˁU;rR=>Oeivگ)ʞ,(#K>qzؔoٛsq=9u__"d/9(k뗟ekOHT%: rG;z͑s.Aj3Ik췫 ':,x<NI^T7ڬ^ :T CTtI4٢0][ku;7 {j'kO)L{z6VP=,JKX_FVmHN5OĪ`ѓZ &2'\Y{ YPа*])30(֖r䕓.e`ga^RPVqA]7A(UK?:Ge>}qɑOfL~ILhwY ԅbh{w/t14tv 3j84yZ*;m6N[#66W,*g`(͉Y`-s17O8w<ɭ{=݊q@}ZW_#rO Ә8 W7}󪿕}zv,ʧX1!,*.+VA*="{aAs䣮KM+eb`qYrY4>:cv${AӱBoF7Qߧf*N D/x4lYSwXW)H4IOt<˙N9Ñ7FĶCqz\@x :{O#K-U p_%mb%>Y!oe 0K['bm0lQ?y<-F)t1*?R!G;8c:ˑcf>]<e~J๭q)n%b1V:QXe"%GC'CJ TH(̝(WN1/)Wu+D5ٷ':ufRʿ))L@wDAN蜥w Y,DJxm)#3NlRO|D Qg35nvsPh,qL'1d"Ot@ߵV΁+@4f$b]PN$: X\R/ Rr/+Uz}J͊f ^ۈ5pv qkY=-]fQ`BA[]{j&sSt@|Sޱo GP0yI A'V@s l!c%2}F.tOHH[Y1tp|c;^HPI$BkWfGK7۲.HX2d*ÖgY~x" Xs΃펎 4Γ+4 mKqY_p"xkAn&D1qX$a.mEJIq0Q&IËLÜ֭ xWѻdЋN.Ԃyp.D\?~WGXwtSN4%0/漌+VptWP^ő!﹭KyZ*LPP>lc^qzj%wB@z*gj\EŠɪk. \()h>O=~ DY鷋Wr\bRG+\,X$ڙ7! mPpRQj*1yI%8Hx@ M\xEx&z߈j˯ /] OywYF6uV#X̼"dh~d|SŹt{SWrHg:tm$+%$%O;GTx3?Tz7GC`OtO-O!hm`G;JNjab%dyؚB.ADrYF+fow(B|*bWY9ss \yŷ ј YƑhV7l=/_q0TPLQ&5'ǚ/*e]Z Ej8IZ٤ ԙo|pNi"W_0/ U9~> ?0ibFq&GՖC oWU ]\MڂS'ViM+Cv~XyqȺ|5DχE(^`g aLP^q9RRuf9 bfoŪ aYi= 8 A`SM&I*, gaԐmKdq:I)b m e.mS4]3#xqJ㫔I{f7!vC䐪-^{^l20I:{P OZݴΰz/Oc+Mkt!ZsKO$gIu燽Esd!F)4BD8H*$i&t$ڎ͐‹Onz`XS:EbinV6=q2Ia?頷jKݼ FSbMH"Uޜ3>˺7zԦjc65גm5{e3afykbzD_ۯ^; @6*oID4(-WGg"4 ༢_e2'R J[cLwyEsL ST0"/ϲ3rqWYp)c0GCPm?e橓"pA7 &"izӛ-)F1swFu0#gFqJOrf wVF7"Cվ#0o5\ &Js;R 5 )O+AqI \Bk&CLE5u7٭Z65o|:Ou =˙fb[!%B `jih`RWsR57R%2̭W30U.W3 * ClRz\r`",lb* *)_S&&WFA*a<0?H\D|jQs'1(ҊGpPuS FDJ Q7%R9ى9S4c6;/<WlVגO`!H Z,o.tCC53TFt O5/0S?!r R*BA)) ]^1}myÍ5 %0Q;x V 1.tCR4y7 EW(e4 #rr 3\=6})p1g AQg^%a?(B`ᔽ&ʩ JfءVUWU4 8יN:Myr{B"f.G\!y;E#5]B 0r(G^&T'MgO=wSbFAr78aijDR-˶8snf˵_{3#*%m8 GKcKuP$ss3M{RD5W1ҞkLYK$:^B@:nwB j>hZMlgm>'Ëʝ̞T~ 8lz53KPriܵ0G^-4+hݔN;JM~VyviUYڣ0}'C# )VO]Mbg:g?Hhz:/,iw˰ߘVMDEN8Ɔ98Eǰ^%9]|K|2m0m%);3'R~,R ,Д,́*.xD9={m9YY KV޹d҃ ^kRf"bFѴ^~+js2G9VBtxd'\TefNRty1g%k Adwl-PS~f8.O-'x -rե7 HLּ6<.ϗ^5: |zZVIgԄGx)/M3^DcJ FNwWݾ7-*佊\՘ %nZ( ϸu`;F&9D B]tIxs(_^+q8E9Qx|O HmR aj+i H_? O07(:XӃi, QFS QSX]no}q(@U(siGhm4a;RvOF$ۛ,6ɝvǒɬJ#1 3q{I%e!ǷARmج),9ϏH?vM#Seѳ+=[JI%4݁:Bs #[L#MͻH]V%y>T{|'8ZXbIS2Vނ?cBCaR$6#;? zVaJȑaE?d5K$0y=q?y-)O6zcբCIJ%J<$Cj4[SnZV%tE24+9G3tB:Yv7_q5 pJ / x\BٻCr&o[>ƃ>F˻Ql| %&{x_5NU*uޒøfd܍$eud]Y-gHZh ;N'e[ y{3H*{x]T0"K'ͽ{vǮ,ߔ.>cAzDWf3-Q5(H(<Ϭ+2m_P!Wd NM49#M(,"bc_'_jE_ b-%:ህU(٪뀐3}ޔ쩲IDӣC)ԕpPya m2O,F3U^좉Dϡ|0%$$:} sqŒgdFo0eb5=]̀ܭUm2]cummLӋw,EqR;)C".Kـi#3Cerr>]!뺨8l^~dx84aІ$^jդ7t{+(uBnuSn?C nSM+xCt5jEaS\tGZs euǙ@Swkmh&3Yf(ޫWҊ^0G)p7)]}̨o,Lym>645x])v#?lhY !ym꾟G񫇀lXbr34/mL8| 7BAw3uM8A-7i,VxƖUjl{MV0,Hacȓo,1tmZdfƵ%KF[TWH;!,m) @ptt}|Th5; G 2 \C@z@**h6$9ZK¡DY[j]eq*Y 3]b Ќ润K7B !h6NysFHIL&vrǔ2HEXZk? D/rC"NA8D}VODw?LQ12$. Y6!LqXo)_d#&z-lTD`X)w80඿'kẌ́nACtX)NHLw"p4B4-V<|gz D>qH͍--w!PSe3!4/a}ܲfk\Hgֿj9Gs BϺ-Si#ńa7p0kN>炴h ӗ40\Lm6:zq]>W\1FZ1'rlA[H0:)8x-Da&-`"}m\0ΌM=IVyZvbf%EehƸ~d˄!0Vˍ@ .;/9]&GБEjF/'V 1"ľE4橺&R |԰BOcW`H1q3R")U_?%mspd7ȭ 1{]e^YT"}~Fb"1. &,Kdz}o'-ՎUć9ۮd:lI0`lB(8LļsĻ/ːglf x1.l4;oހ.^\"GXпf__+q109Ku5T𕅍ćyZKqމ5`&@桃&Q'~Jq솾G 8pߚVE1Bqdq_3v'E!PҔ##Cԕ/igǚ5Gyw._9 3_pZU! $C~j_%PW(kr<Z,^vC$Szق ۀkb(vҏTDzlukX@.3DD=k5N;B"uw$BbcD}|1hC|P Ah|O VIU|Zء;}"^j_Pf[J0nfd][BA;_!qҔ%)ڲr#/jaI2l[5nzC gcCgSJ~@"810wijs鍦;GNGvC|?WfA|Ɖטjnbtܒ {z,FgJShj$|OOB/0" 3j]FC^!qi VAc Z3)Y-,vPFAU^ЊNX̯|V4(ycBp&J_ Qd{ f־irP[f.pD&%#+d<鰿+ 9Q:J-y ~ie7 wou݉F@JF:Ig}Rj7,29%Uux/Sg|˜u Vj#_ 5r>``s T'kiu/+֬쩉HYRopwe2) ʋ˰HSQ{@4𧍤 / .貧r!uߕ~W5DYMV*Њ1IxVv=eJhr3գs,jD)C-|vz> U]1$\D%l,bV`xMu3b&yFH䝽8Qm)Ur T;cjUCi"1YFqڵє 4,ivhE0ygKBHm3$N9MI<)"Δۓ#TPvq[VÎ3 muPU-Ґ结I SH?Wq#[.ql#@qZ!nnyb#Z2+ۘ"uk>*ZD'˱36P6(DfWFs2x 2gt~糩wz3Dg \*ZؠicϾt7DɯX/u%z|BՖ1ި+ ;W'{;v<Ţg@. 9}wo_bYz$,u3lQ"OdmȘC6T#X.K pɘj5MEBUȫ&dѮ?y#b. k?5SvOco bNLݩlg0!ځ \w6y9F`ERAp+Rsjg=Z~~p!o5Y8> M^Uf]Dg cZi 7^'vLS&!^Bc[΢,H-;x7BqOaq.-sKOaD-0؍qol.ox/0_$aش,Sbdn"$,*]|XLWr.;n+¤/qBI7IH`|@=_LYD;qaMM<f%-v u MzW#D<[;L Sq)Z(Ikz1tANӹONغw 'KY)QMEjw ?EUt9JUC(Rȶ$)Jd0OT=Yh%J{r<Ϫq++<!D[xP=O:TƢ`:[)X ^Ǩ4W7lr1+b4J"dE4K sK}^ZD1 F}n^~])̒f_D{K(I[>0 YZfPortfolio/data/SWX.RET.rda0000644000175100001440000021236013630677273015150 0ustar hornikusers7zXZi"6!XN|])TW"nRʟoÞu{fKEMZb~iXAɺzn%UbĉH^$Zk.fsof.\sQG$`phzIoqZV[){aK@I;GJBbbUi#Pm2~ b_q>1\9$)W+G0ߏA_x} 9\.;n`O@ꌯH"iՖ.R1\7xQ6ޖOmQ-be3a>}Ͽ!W1z,58q&T=+׬X$qXK?85W^5}wL Zof#5զb/&ow{^]r6'2LP>?\(^S1S%὞ek,3I䃲 њƗtv61 =#@QlCFM<1-$9z1ԩMN)A="IZKh"u%R]rvcO݀k4ИۜGsHd82xCDL\ Stcf:a#ȿ?.Y,+g*`y ՓbUfpSd E+c.iƉe:s)7LLߪX7Q^|`<ٚ9\Mbhp0#5E\ {KCȢ49)1rctՉ5k`Hk?FM⒟SN ?QξIH,ΕP( F7&0`hOY%QD`sCL 5-{Rxz:?F~r)F=[佰Wu_ӽ9!~`Z"UG|tơ0`dٴң܁k3*LL1Gm]ڎ$1, Buq̽TY7p [/ Prȵn5.?<8i{UF{@>SwʩevDG3dj왬_eNi2S ZE]r_mM s`CY0"מ4őcnIɢp?d֪5M{a Oad/ (*u+3 B닯XtiDW2 sL[wLJEܔq4wdiJysdz`~8@-Bt$pyb-q.H|w䢚 #=4;;W2< <.hǕu)aZ~"`*e325@^9{؀v/FߴnϴIy]!{Ĺen_qH@kl_j>\E3ls-+[Vv摴զK<PlTْ+n!t/p(t@eW"^&)[pYAT_~$ZB`iMdPizAf%@ѐ0zz]VȝRHv#s[C,xUH5R7|1A@O0U!|Z󳣮Ə-qϲv]?eZ@$7FGz+ 7 ,›e8ވ2ǫ''h͡H0<jaSjs%x e)n^ bh$AW&ĨzH82r668sL#3^K[wjyN!I幙O~ߢ_aD9:Y!qG竂 mgxP6%}U&6 tĭ[?r"=u`ٞ> if4[}^Ҥ یFeCZTdF|RzrkZOirhВ6V]ZMjqTW_rp>q. - t 2%R6_(6e ,&PfE> ț@B.IKI]Y ^ 7C@N5bȎ QüsN|ZҔen!{?фԇ K`H"}Avg q?Br j 59݂ T>ۜxlʣQ7ٞH=U5}E2J8޵-I24abD6py8h>p3&8H|ӃZa]܃T|FB#S/.ܗg Zi-~T/ @&O7qF 3| L|](  l1k&?3#xVXwoMyN|EDScm_KSHJbF t8zi]sb似sW Ge$#FճS`i7ģ)g|"8%3_ "ZJJs|=tp],Wߢ%dY^n8N(mxr]qM .m\SbRap/" 8a!xo׵WE$kT?WiWbkӈ#oSX:-BTa&Z]f=Z{ A}2oD r,e(sAI^7ս' TQtCIDZZl@$Na8;Ag6 Mkh畔-/;H)w}(lt&1DVT[w On,QcpUE~VN`<ϫgeIoF-!$]!HE@06iGC)b%DnuoxwQQ޹K׷v|"+5+])YsZej`;ŘIֶ^'rq{ԅZ 5U(L@Aܑ_@GF|Pu3{dC7=\IӘЇ6uA w7a`dAY;Jkkn:* L³_xFG8xs>|x)#Z gm+X@ AV4>ߌp蘜(PDcr_ҕߨ48BY؃85S1ZSzI NS,nS2OWi;9;Γ|A쵱N_5ؘ3%P͸/B21ܼ1N6ei`]5JeP+`<*L[ovŊAQGXz,M%z;[: &oej$m^~ޅIH>.}+$i|tΖAn:F3CФ(ŭ#UX5=۱lv9 kXNjmJ={˧wfb_~,k]7pnjl -H2'U5>QWS̪**V┿!X @.tܕ2?-I& 4 `8aB~dN`Ž ?5|2⒕H"z7?=cn^|HQ?I~їْ}^vՇ(ŕ?٦g8Mթ4m=ɜʕJ&{HLVZQ][$йVQܐV8wFLF?n{œh.jΈxXRo''FV>5#*[w8z; ?B\F@`nm$g[YVdM\ qC֤eD +v|TDf(?Ua;oSh.qŇA3c LSi2?ѵb1q` 'ċQJ€K+I˘Z&"ikC&><0Xvʣk?߉o f_rpX*^+"1O9SD?G(.l{3{:g+P\7E3YA0,Qn\`*_hoJ^wUP (;W4P9\,# L%:ӈM4sZD4+Q,'RБڳ3׊y#7N$NAmpBEe"tP=(IVvs^rR7Gw[) SI4VGjTe>kǑʉVJRDKWU?0n8}Dlx62AGB"kUÀZbaa_UT SָE{߈5J9[g{q tD9))؍4ֆ W*@;ِ, M$P1YXa^Dзd͸NgU6V A:;G }"15TnjX(L48a,KFi2z"cuN]nx!ӎB v[3 `fPY0 tHC+Ur+"8jʐ-9 aD1'z;?$0lȂJ۾;7[g D$glQ7/:$fO&g|v]ȇcffirJ Ճ10=zpA'9LڋTH=J[Sp CE;?T j]{-[C?ҧu:p~;e,vI+y]l *2d,% &>XrlpJV\ ^mvKakЁw V'%)#Y9L XkWv$&+ixV^CϋeG܉cU'#\skC蕩BEyMxz{Dx2 l J3?Ud_,NB}u$.Ļt( %nCy\ml uJh&J#qmqK&8_ m6ѐS:L#x׸|覔p8YZ, >RFQ\M$[=jsMvȞҺ5q0TL?܄>|^'t9_A*qH]#>P4n ȫ4ĺSR`gLӒp8d= rY~RB)e$΀I~$`-Nrh~[NF1E&bRX&ˈm;F^dA0lk]H3YWHg'lփhkʲH[T`pta(8+dkNBߢ+ȦZ$R*G+Wr*s< ѡ(0|DYycŤڣNi e#nd^]sYڻ rt@TƧ^*ɱhC;؇ZR MWG-I0됰[*6)7E9{{pg +|`d3ޝ,BF5w>#g(xГ"H@Ƥ>[xx07 Fq|nJ.Cz΅$rb8C3D8XV]sg֙.}z͐''Mk5n6j nwέBtjqa-*ff]Q AƁ=ZKk፜H4eaX%c=~p'}{ >L6c,9lAs붭UliP%1sM|~tw/K0"uEK kh̝4)ͥMT`ub$r(#Ku6n%| }7 H뉗!JDWi1$O@*reO/47kX9~bsV#^AFrfbGֶd֧eʣd} 9jྍi6Q.Y:kjҗJ=j8,~tA rgk齏VO,Ppn?AݷbLKT^uCQkοtȄqt z/[Y3/<a=֋TsDBma:_! LnPX ̐w"L+x_`ra'٭q]{e+=fi$#!\㌓ F (?QNZ&+S!ߺ<~F;fE^ȸCًAA3wE(Jm]jj{8^FBQr ٮ҆/$ Z{6τֺt>l|O+Cayy5m `,/9{xͿUᖕOғaU%)5[A:j [2=5)L`#"`;q@,"m';7JwlQ;/?bC4D/& Zsx;m}֗519n 'PosG#)w8 RNx~ &n{ u5.p8sxgkE/9yF{CnbR2(3ˮf6TJTJ'÷IXP*pozz N+JJLWAJTs:yR%IҋU݆ 7LJ_ 3_ҟ9 ۢ*m#Nzoy MD+3Ju>^YWJGn[{i `~"pt/aV3=bQ)lh_Yϖ |^K yG=`cL)`o'cwT]ꙂJ0|Ӑ\H#>2e 443-)+'ub}TFRNDAMZt+ԫ @<p`۽0lRBqA?p%Rp[JCKW6W>b~HJYi3-WYB&<lqAT+|+0WEȎ͚K1ל#S4;U%bK`L2\Z 2Sn*^BFxC AP55Ɩ֠Btb#Q[kv&p3 cu%A91+?oBp/\nӖ|EԻ:na@q:<_P;!8ؽ[bLXLM Z׹tP ܑ7]@'W]S1Fx^eI`aމ!>3˃7~Bޏ4 ٚj[!>LS8 ?}?,ԃ S [2y_7m5fqJE=W.LG]>"o [E&k@3PKЛEԖ$\y DY*z/sfr"2I nǪ.HYКuxWG_ UK{BκIg9_4d3w(Uo[g)w1FkytƒI@?B54^[$fo%Rf,@ II ◗faTFCIh~BKY?A+HA eQ20X>aSB\rऊn5 yNa+Z^fJB b@yFP).Ew6H%`Ji]Eq+ Mm 3rN|}Duh%id`0?b' 6͈d5sӰ&h'>"jn |S%om  2M aKK$a~vb>>qmF )s8ۭBCg c Am쇩Acg,d8qp@Vl!5*~"5q'3QOtGܮo~:S{w P^H/*Wҗj]`_ ay7`rho{UR>zw.0IţA 徒 __ W0?vCY 8w2[Vgܽce4DĂ`XtJMOQĩ3["A2'K| |C%'0S~@ ({6k;q3*λ 74LY'E+.-2Nv~T zS=cK#m%kĕX<1k&\[%po^1r7ĺq-ǫs'Da n mw 8_һ*5ӭ6D0k?O%b_TIy*Ir &d, ͳ$ ڛiy5!@OmG ]9פp왦Q rIck7Gށe͏4ĈJRXmCT<c RJ/Uz!~י/ ؤ=g_nlLfTkk\`ids PMDu܉8?s:pw?)oOv]}+K ]+)#/]jU/OB|b%8A3U-gT2}:xbCY3tB_* ߘ}ɺ /[NAThd$?ç_Ah;}h ٫N 5 o/80g?[6{46-tȚY;Ԧz1 ֣89gM*7c$&v;*647[nn YA J%.zGxsIRvlm1&#S?X-AⴿnPrXvq tA "T%KҖɡxD;o5+qǵixd93AR貒gXX&F. s>c <3 | deQ} kX2v͈!F)JFnqa=)qϖ3LJ6J VaΟ]@ E/׏ /*4Mei&А⬖L58a֍sh oRȘ(=`>84,.dc7iX55Щ={xGcws#Tc~@q0Z'L:;ze MZq1%MAwDsM/Ф1j|E [4ĂvJMO vꇖXkQi~swqbk\DíOsldU_TXM]J{9=OL+y8[HR]T\$5t-b:X8=o C ET{BT,(0KTlavgU5!2֪+2[2|~rӗؒC%qGs)Zz1iXopi#uj9#"BNB-N Sd=OO@]IPksc:O`Uԕ5Jf#hOIhhAjXi&A:{?}3 ;I\:1c !6X{|mC:zq93?ʚ xގ5g0@f5v^W+B-|Cπڀ$ ": JǦ <Ⱦ[Re`{wRWUX;e- 4o 9L1 MB?ymj8;d2N}cSMޚا ,,Q#;s<%?$5FV凖6nf҅">:W:b^PM?Pӣ+K[}Jɨ5} X@NXQ>IAc¬{gA}V5\<*:7ң6Tw2xȦZ^ָl*5uZ4|-KAAсxV\w <UAIu\_FÁB!]E.棜{mv$McPvI*時ǦnƃoȑC?63S0Q ,N A^g[](z a<=|76w`>-]دR(Vv7.{_%M>E3P6t,*FĨTtYN N>?9o\RDr$A'SөUhC_%1A#^ęC)˅9Tpњ*9>>)~s\̜Y1?uyC?ezR`u;(;ǹAk,O ?>35D$'SJM`a_@N:0*{pG^)ȅs-Ğ#tb@6B8nzC \9lݥ:K@2)fB$]W;a(绪|yQxn8ii5ζ,9c>-QS$miRQ' tW 4uOĔ~9l.:ܺK0Gňt#m z\ćY/Uu8S<#|R"Sos~!N ~/# OkY.3WPprG@N L쬌 i |%ο*2f\!a8Dž|j_ x"/%xpS)Wޏy<^lGgv5u 3Y& CJo}c/[L(%-&n\aRdC^{G`wìa?c6]LFk20foF5>*{6 Xw9;`fג'\iaP*aic;9#^ؗL#ﺴmk@ FhĽ5C^ԖgB* shI8(3  ˘8t7кR[m@/g:)/<Ös% 7,\ W i9t700L+i hZ  (*t&#~k #  'İ ;E|ɗDY6ҏEYB{iC_E<^/'AS皊!bBae@Q` l8R(?&h|R^<#yGvL E+y=hLDR:K y-!nu@T`2->m0"V/\|Ńe~mRIsHG_.2^1&%9Y؋ۨQ:** F dZG!aNVWƋ:h2\O!n 6|~SX 1I"K1V"J"ĭ2PoUEe P\Qhۧa3jm͏l%ECED$~d9pҽ[hh\jh ݣHPevY,_YF۝2=}l8x1ů-4&~LtGͥxȿqIuvߊGs`KXF{_ϩn%Z.rI Qxy0UQ\7=l:3_q\$cQ}Ͼz9ꥁ9V V3c*qmDB9u@O܎_/TK u&=.H-\,"g5P4d̕no%Ͽԕngh8PEg +3/ho7qW|I a;ju̮I U3I8iF=dQo&c:wmzX:@5*B\o4_uu2`0 H O[g:>̂ڄ BaF܇|\&V%ē]!kߺ?2\ WlAS" ) 8Catyˆ~BʰQaqǯD oZkeIy&xEvS Gp (qW5ryU0/>UYwSBBO+Q)+6h[a.`hX.qISSoz_*qh/uC3z O=ͫlmwƱ+(C^̿P=gEIc*A^zqy\Ӫ6U|6f!}2vpg$E` z'Qt!XHB1uo% *"^OeB&v!%F釣=Z`Wկkq^38vvaVKpSw Z1SoQDvsV6ZMW{7iv"[&1=Z:Fv `|:Oӡ:kL0=+*XLi*;!+^d<͢Y;:[؟O/3Ķ+9't(pe~:BAŀKC G)oqO|k? 3)P)_wCNXjzl8?4HF7s=O>ש|FyK&%u?҃ 2>W9$]!/]Qʢ ;JWHi-vbvj Caru1,ekvGu?H>Nn}&gWH~/ώUL.Sy K*IM8ο[Y W/#)c~RQ6o-w˅I$3gQT7HIa%&GlS)%S N U}q:x"W뾟0!R ܦ:PkF D*}M_>(JKfBA`w:1.ti+S+OePg1>@MNait(i[$r@8)^q"ْ է۪~.ċ*{J-Z.,+l ^VN jDq=(FǬfA}v|' jaz|$55&Ϲ,g8r C}ݔ&:P "ճtZPyDdDGghY5x>n}F~㥦r%#xNY^+ZSU2JzD^hO-uzgSzm}ȆISeBA("?T&~ v:9H^Jy tR4ZLx̪iq  'jjaK|2ڢu v.8A@Ε ;@c&"pཅFbԮ }ݜ9*<57麤M?͖?s{5Z4ZDl#eTٞ9̥ h>zh}N QjKKPy"u)I[=j&U.3dm Cw賱\ ; L|ǣ2tο5Ql3ֻ`ڸS>z/Qư=_Cw> .fʛp@b}*v^/D+s}EIrʟ47ߎ3 wRc{;Φ>]%_k '}4Dx":lՄVfէ.7PP쬊tbhcA53k%kTPY5ݾ1hc@wF2Ϳ(xf bjCTt+D;,4ޟ뼄 u . .N8Z:4jIQ [___Gy~MN/˽zu {2كRel5&1a5nE_1u9!>E5^o#e;\5Ro) 獙5|v9<@.RE)R0U`uah/npCOwYGx( DDyߓ|p.xY{hnigpoİgO7X@/ |e\tbJ7kw9܊8^PNvſ`N=bqީO e{'4nww^&u3YgF[|ٯq]s 9J5>$oPvy'tTz/aO ]Ll+TF={n-ԶkYFϺT^#jId^ǫ{3qg@[L QnjYi[T)~H.Nm6ɔԻ.; {_Q%^Eoi/Đ DG7 ]D$4v@j";!KmY,ֺ3$wd'؏&`l$\* `/n'Rm3ΝV[>>jZF+D2:FU񿾬{E `/{1r?6̕Aߚ-5UG-MZЈJ* -uU4͐}u:cM`-Zґl[c|Q5KUsBQE)e-~L9栓lOܮX [ -5#cS:Gw0}gDj?IN<圥@&ܡHjCgAYDZOH2iLQxolBRgl.fW0RkYww˞qL \;Y{ cNT$o0]ɩ4 >l5TKrX5~.yƴ0l3j`yՄ\J pz2o#x1]&7*_ v/D4.(G8iX;s0gC@" V`(N|ff62Г2D*j,}ݻlYhnLM\LIuw)+H#RFk=..E1jS o)OK7>K0aN>驻`? ID"Y@)&?ee{9_6Ӆƻ4gyn~3cj[Ith:M/~YC>{sQL(n4=f6JOnۇ$*O״4KYLF!z}b/!S8Kl[vÑ0lSxOQD 4 ۽Hdvhg/..TZ)LfqW bңRT5q:vwR+;K .t}U+ax@ ZU5%)Kܲ!ZhU%J:÷<0^h&Q]ZA=%ɝgڨΖEvp%h5#%yk~ Ls`bpy{=Is<>MNE ZU# p+F]??qy_CboUUܬqz9+[Uĵ|܅?4vc\x2wq׮3Ahp#gAݕ`Hl3Y=L孷ZٺlgM$`AVm& MjjpAxXyH͚բ@l3f${c h@ ljG?IfeC#)lx|lg{痉ZxpC&Er1@dX~0a3fІԟj$:(­9M'w.5Q,+:iL:@ƫKԙ'x+xQ+@acTk BT9NpeTdY|Tq[İC&PYCs5ʭɌ)d NeC h3>QR|*gxfZJ(Tq-\<[v|8PetWz1D  CC썸J/PG]!_q[" c.t+Y@mP%"(zW/}3-Vups/ִcM=ɀUfCg6lIRϏQxV\N F1܅Au"y?}J4,0~D{т:#ͥ^`s=<58s\`¡S?gHq<8h,@b_qw;j6ZrO_`lFu~3OP֓V54FCa{>zb@Iv!O]fc4f"BC66;L4l/ mG&сſ9qfʣtSUϟc3>iaT{y}kc(kE>k|{cd{M b~UY7+H=.Cp!m&t`1 yk>b2,yA V8oInhiޡt+:s d;v+2_I\ЇKQ0a)e;<ѿ`,:MZ)E"{\U)mQ>\]Clw XXl&;G&bFؙiƛkNqu7ͼed}J2|=ڂchO{*mp$\E7Lv _h#*wblHzlj?{:i 'B{_i'9TIYݨ 0p<}ʽi'f:iCĹJCSV&+YeRk[GN0"PpgOt[^eGߞO+g*Qu ;㲅$erkw /8F4}mN!9-Kz'h73pٜG7{l5B/i\S-byoC@j CVK{ʪqh9N<((5,V: )490)7*^k)׋yĀUN=epF{3xm_ʦu$s~q"B."R/9<y7Qy@ߺi5+6Q[^^=̰ꄜ07(s&? `^{Yzɶ:8"dG0c\pRC8\Oo-]vBgF B%a=Ş GEɛ F>ݬR-=FUޙ{9\'Z󊈗 |T>l,e3y֘i!AեփFRB 3 o7zjs@:X 9aoOx91}x-Dk5GNGMl\3½lFNcG{iʃ!#a`*B;B!r5F-moO:ڳgXOGS% 7[ d֞C֒_F%jJBAgW*Pde^VP&> =^zb긺|zr$ڶ.KؚA-ڣOR1 XXlC@hED4Kfpض][ !K8A#kJ>FҶMN YhAIdc'¿9hv3&ݢVWi-$쀦ϑr5:`ё/ep<~tٶ)ݡ$и//׌tmY-cʇeuD|QlgO)9Gx(Ǐkgw ?e+mSVJCe8MzKQ_moN\I\D Ģy(Q6 YʹlfѪviGE~*I HG_Fޠ7y%s7 sK Lˋֲ/,]bl}cP&ۙۉ{LLOPxBU_Q=zDK yBצȺD {wQKTa%=< Zc&Ô@iWox:E- 1韥oߘ`-6YN''(qv=S X޼9,tAP 8y(+# X %gA;(nR6VZݟ 7% N%1r,bt nFKy,O2y"H^!~KkQ-7ƴusm9ew`yw]_e~ο=&2כZf/qK(_lڽjr*8 )0D5F!q6-h~rȜBkx2SdЪ /6h ܿ!@Ld ?k<--v-wSo82i~!VfTc>HI0DxA{:RgH֭)#Vs>\1S&Ub.e) d]-D^8Uhz6~jDK 8_1"ėO#zfġFN8|CSx CFZkrXTbQWUWVQkL:hD'#@Ƙ!/@bWOulG|@1'ج<;Ya'o{}}e]*Ar!Q%cxӭ]D]i'ͣ Cvlrp>; fK@NkXZтOac׶)w~m>NFq0֘)y4ifb.x ]S2bonn7$z2>\B0 }B _X,눱Vز;xP]+Ο_$n .:03+6..a4X!jz pv;=CQY`nN6[90PᔵWk:N-8Ŝ!c81!m,bum3꯱%B28\I:\݈FT"q鯷+G7}vTX1+0ן)2TwLo+p͎a)wT.rW:z7dvםvZoXmBW0r&Ȣ4;_L&Fqk֙{!β>aW9o S:+8GZo/ڕ}HI<fZSy~& $9Vhߑ_ ;џbvb>L=ϗi` ZKwջZ"nٙ8mFR$XUgPjt (w t&NkF"8 <(0`T~ "݁%HrDrPxyU5"iJ`sd99"dM` N讕 H_L*ąaƟ C[?j CkXY;Gh>` R ܻ2s ԭN(`/U{%?G$5aKL'T`<˄rN#P:>Cb~;u ZZ!iu~D^. {ĊΌH"^ HlC $&!y!;BR=hɫSk_˾};'-9o/(mtfs)ʔh\x L `^3#; "K=VceJ8 _ͰӿE4g#΂`# qE`:Ic(a6˓~/f8mL8ѸsH|\`ޱUOhCKq 'zGݏ80pp# Ce2v ˫4tcq!Ua_GM"|sQKZÝq$g23BkE#6\dD&l^2L7Z O  Ң_,p^x[;SOw7l׮_hdfݝݜTR `:v} .>$A/x0$3z ނ8cS3L]9QG6ľI&[}tdѼ,Pg[:>,8H㡮9m64:OY-8MéQvY9k\였ga'֦mU@" N89DWfhAeâ B\kѻ#5=SuÕ՚,CSjap*mfNt͌O?w ^|YHlQu_,7dk 2bk=HeG %OFZW"uacz3&7$j!pYm\al!(YٔQv1/fD=H8#T(Ht!t.j'FQӳ S=s?kFbb%#˪Pb|w›]+q?[9jKdj}NRrϮrs1< g(r.Jfz ͂:9ΝQ8]w>$K{8P u4b4KSb:>322uA\!"J\8QT-.VTjU?¾RfCAv>A8~ S_ww&7nvslOUƯQTIC;DT*ӊϢ)}(Ü&, MxN8+*"+0Y~턪5)gM 'P(.R(_fz|~ d T1[E VVa]Uwd`A4:: Y,wL;ESs4 ?-SfmUy\^5[v>9bSm6ve\k"R۲~D%/]W^LOZ 6!wD,qL =%:I 5a4yyՊ\Z+ԢW'.#F[{tQncx:!^#0XYa&S}A~T j(][]aӱw]aP%f0l-A)*dȃYl9(-Hyj~.\'W>\"LT2뿺y]Ogpv/䯸 VY5lzRK$N#]ck:_''{j9Dhpǔnכ~pDk#S*n.nzÅ:ӕ~Ţomw(V?lpgiZIILCh]Q>aPfd0O\B6ќ|:/ۆ5/0Fo=$({k&;&  & Y/PUR1;'u:A3iq  "m]ZO,И/p+sT\AY$%g`(XRZ<.DŽVN~?D#yȅw^p*oӒ6'T# Cc5V1jg͡KUR TM1 Q4i&< }~G-@_%"2đP`L2oNӪj2V9S6 5Θ%wKCd- Ʊ!sr4`ae5ӳ*`\EUڕ;bEo :\ٯcG|jOD2SW ؁$;Q(Az72.LAE,-\Y߯AyW}O; :m\)O*,~pgo!)ӧz)p`*TlKU[R_\K%mWť@+`9}v^3n8SK"P m{,+h`DIp*M!:- 4/\+TƛO`,UqFyj1U^7o+[7)%ٜ @%*y౨V_ʢDxai]7C=0>wU&^9;˵py;P.,(Dt bN\gkzUot(qow6R]-b&1"fԹkd @A/d {5+UNDf䰤èPJZ J+⮁A<#(-|A|>(>'m˘v/U#cH!?5}7|p&0=bY 4>"&ѥd ^ܰag 컢5?Z,@q]=KR!dͼqؙO7sJyι;ͤꍋYzc Vƽ|X#TG留.I੫1lSEKoH*QMh}+a2ky\E{[zHgdӷ>K;11I57*H^)@TظvhfOZkܢ?٫u_1_굸g ?3BzJF kqntmm\n( "U+ZaxIckkyNQeU Ritv$Y|pOUk'ZDqęۯKR}NOOt>B> # 8>2u#;qI3[m` fC aD];X0Gπ ΕwqR§*2Q>[%l3laz g<㐇W7F#,I_o[1\R@#o?es_Xt|*:/w̠\HpLԑ"!ai>s,&|Ի & K HuDzy+~)}FJ ͡hӅ5~w9,GQAAD^E< ;Fa1EpA%Lb2<}XK~1lv87Q0_wH9f0n[#R">I ΀ޥ>2XHw\"Ayªd^`}j%ƭSz{ ]bbg9d|-+lW*Ԍk!%}dŤIEQFO/tL!.DA+ӡ3i9-_rߛZ,?a}XA 8%i!%nSL0@ɇ+׵E{$ ˢRbWn~t%Wò2g$2d.WAw?PgȚA;Xe{;ޗ>k}kYi/pL@i.TzzQ{),VhiyUdMiV~nq=<> pH>m %Zh(v1a.TAp+)'H[ [zmĩ< #vIZ8q&v)q0\PKZ+PuBҠ.V9ܠ|Ȃ)s:&|نM8|Ӹ^5Ml3#V@2GU". XMﲜ$ө!NR(bnܝ̸+ cUȬ6`g_Uqyx7Y-(BȀt; :KVYb!(cHvRE&S`diFcT9 P,`j;@i5=\mXL0LW: Agu 7PmDְ[k1'#"Hw6s$0wl=ٰ2 c:˝BQIB@ 3 c}`XfXr9jb9" 8ffd޺9".V>H|NAHckvݏC^ԋCA{q׭_bK1gƻy|+Բ9.:~5$m 8kLBȇ-tIB7LǞ3$8Oi>I]nL 5/%fN:C?BT&& p@鲏3! #HTL!T@7&0ułXc9TYШ}= +nSٿ,!??@Bj[,R"!*L6s3<N0Ju?.!/5qÌq0=B3-w)1u6lH1>So% 71u("#=jí)o'3(%HoD >ts*B4Jb8n˶!' xC\)4I$e%MiZ> 7ڪ2INR>>2YB rh5ٟ=hLASK |a,30$_}e2t;XCG8##G,QT@NFaÇvx׾.}*/'#;>!A`ɩ)wSp56B Կs#8A>:!2fvS.%f7b~.F`r/ 097]-x,B~ kq ~迗6 L(8J%U1wb;yH$γ9Ј;V;x+د4EDZq03˴R~tPV$%LmSׁ$7<`B&E$VI!*F1p-zՊST|ߦpֽ~@仌=Sxr5B?EN'9G:bpv$#\tyEV@vh\#罺HrD'q= ב.sIrEH8m~R; e>M0K7$c&9jٳOn( '0}.;4$8+|jj)mGԳ=hSRtR$~'nFQqxGv"i&W *?O/soo̤aI.a5i8 #6 ]/h7iO5=iri_kRdnY!}WŴ;LJBџ-4&OwIsw[0B3#:yQ@|&4ǩNm~FIeX>+,7JYsS5}lls/fޟF{ *5~]')%h -d>x5=ɝe Ǝ@cL:۞OzBVKd^Ҟg죙#Q^] .DeC*#Ui<'}.'O_ VbwqY=("hVOU㮿hѱ}c7ˣPb0f6'k\Qg.{)W4=u:fG]g t`i[.53>c;N=/%/0Rv~kYєqL}JwCJe`Y{o]\ݺnUHr0Cw AzʮObMXbbh*9޴bV5K:+|nycB\^uƵ@_{`ۅ#xwEKbXaB)v1;[Ok9 NIQ|sGWbUI42Kk%u*hƐAq!W[&" İZ2rY}xָcj{G42`Ф,ɭ}Ő҈gF3*?K!!p&Yp 5~<pѴ#H;dEHз1R gN#s SJ~Z[8 eRR~NJ͗rl7@p`Hb;H97i:Kd@sV2R$)gtup:xxPEQr?/n|nje^>Kt:(b xVdHSk-:$h~hgr$E?MڕVXXe5I=#N`#^~5e_$rD@#:dT50A;WbS2ܣp,}؟sͩXDѯ,d ? HeE";ҧ!nVqaCVd:XWفZ46τvQ@KуHivA=A/eJ(028jC-2Xug qM ="}?&Dѣ96IT8]_M;M+n(0b" Ȳ, ;lp.obT 7-Fs4[ƌr>d4Y6ge,GBhHuES!6$``ixZEU3P~{BДI7tpo#{62=\˾T@2|:ӑJj$\"\ sϹŬLw 1xo揹~<})G'@AnPU AtM iϣo%p~</c6qiX]`VX[^&k{{ 'N;bd3 2 糮ːU?Fo#/["*/ '0P'x7w_lL\㯬*WY) b$6Wql_6k \ *k28#])U*nO-l.3&QI'ۇJBme-hg[_tIww2<="ZW"k4 _z~aC*)RdaD/ ~Ls_0g,1E:(/6&p (OWWWF @$gzE݂ќb.AQA[]aI)6h0os]n;y(2̀}do cW6 >M *.=Oڶp @\S\Iph";ț]ӯHxvw5HʃQ ܧPĉl Qb&5f#ǻ޾-ת V_/9\}5PN+a-2ېw *5 qf^RD*1dr͕nWeS,zcONg_`-nyH1˿f c-]ҫ)WI0se]g dxƼVW)ed5y [K%p*a"WiRt{ FR)˸cx<fO ǝ;ohJ͕0"3XhC6Nܰs}S$(+f&7-uةƥaj(xh:V;eD6i 38۞;4ݳ9R6vxcHUbOj$$l3xcI?]Mg{#W i} _ֵpm A,y;˯ 8ǀFpe~x5?EtџHMw䘕&_YRAVٖNwVc8qB"k^+5pR¹ՃkI(v&u |%nm"mV]8kM䛊>[cR$֞XoY"Q&;-O>Lڥ9ے+(sAA"3&n!fZi@:Os}Կť$䠬v7ղ4~u- JQOu_ bDL(6VQ,nn~ OlAAek؞nh/[NѧHȟPE~~%)Sa ہ #r5,sh1iQNW0?Ks%0 qJs"gD)Ca&3 en-H+!6X׻w n'v{C4 h=tm(LK!Xڈ@@ =6} (!sDGD˩Gs-+_X‹;O/x}6X6 5+L€]Ґu8an u#Y-4- 3GVby'˹OQHJDAG1(5:~Qn8(Vu_K:9aB㉫ozrHPˆ9sYqpoQs H .wRu4bDz y^9e^4nƽ)hmY\EK뺾v Omyu{n`{rxV'+ ZK!#0ac+U?&\\LW1L L<l= zӴ/ U,~jު0T*$Qt*T*|erӪ.mC3v;^`~7AI]J@;Ҹf+Z\*lw ̧wzpf%]ƩZ~),xi>< <aHwOC꧕|Q*9efǹW}5fI$dLЌ˵ƉNutu/q;LtS+6F7{Tkd_y Zz hc'Z,ڹ {NYZzL>mUn{Dɻq+rvT'#sHVCwEQlGqnRͤ|{j'M-S@'X3z d^~.ratJdn.KUO<0?NAZbdzG}N:.0._ FgSV)@}Y A $!bD]]jbW!` ) 'F < P8>>`6d?[Gtb1X1d2ໂc'!'3 B8j;tjr*xh|kfRv/s&;Z!W+PwHk]DdMs NH~aA"Gf ;2O'u ̏?] ʄwɨ|(j,1^Fł'&66>1p -X+:j>q+IN voD@05|x"q^-6ĖG[;1x /JX] 58}$(:ZWBWyM%kt YF\)K;O]e_L3{Dž ؆ կ{RH7I}+Cn y׊h,E\?/%jmDҎ*-P¥"JCjm9݂ӑ;&]fdk*W2Lm%˜mb 2ׁqXj7B{Ք1|sţglV #pk ̛8K&pôP^J`p8Zq1u]:ED0>PAfX]*ӓ5P$XVDȐv*VoV6Ol:2}`HYzloL[Qn똞 No4P5 u PczU ?].0i95_nc=r>Lx9^,oSsyeC)ɀ87 m[ <X Z.gh=c$i,ιK&ӭZLq#Yn`E71٦q7T݆Peߪ` eH% p\֌ k+ 1ny%":7|ݫ Ĩ "Q`FPTbdY$Y!$0yX-?C7(A%Kz *MCYJU? `~$H)]/WTD/ ؉˝kп7Pr'e$MYEs(g ui;%& jHU*JqxE=>R/zڹEt  [aqƧ8COpAJ4cfjeԠ|q|x 1kO~M<eAoa! ;Ա=_)&ͤ92zӭUs_nUאx- f|P''C$8}ܫiż`9C *ʓsۖ= ȴD=Q tǝ{9j@U1z!1sݱBK{giK@-6# M̽lXzlY[="G,jN|vRbuQF56\UQF*EBD붖-d5&r*c `#:͘$=L)2Q>v S/#yϏ"hhR?CEL&s#ZPn&M9p8J3iuwBLru3`h _K$Uc+hS8dSZ'M&m\B'iݡt5/މԔ5r2QJ˙v&x'81yKb@jڼ'lymw"< m2lcQ.%Ԁ\2Wc:剌z4TkF.K2bl[4RJ6p]j5!40օm,Y< JDGA]dm^(i(Q !7g\]2gÝ'N*, D 3>s7Fu WZ nxWh5~m}2&[(W621~eșx"_,aqO%?Ik3H_KXizH4aF,J57hJx>jOFy:@[~Gu_ىP;)|Y Î[X͔-CxIY%م5jN=W>;ĉE=KJ4lagRqddUO` )/μlYń)7SL|89Ҹlnrrʂb[B~knKe%$L z 4`/$,ZCK=|D:hDź<DøS/k@Ҽa!W1߹jj&M~`wNY@? ^Pќ+oʩz)pH7$=l$6u},T6~)iaUT9=7Œ5Mre-1>"Ra$I%yh=ua6Dj:&kJ56斔~Ouo%$ITށѥküRcI"U6N2݅b8cǥb\6h pXep kċ@u$i=HWX~q6R9F(ڝn,Н#O T>tnM=!Q\.ˏ)>'(7P; zC<{0cA׻G~Q#Ffmܷ KZтl[Xv1k'QI+W EiL1WeWȴ_5@ ycP/8A/M;i{^Zs4ij,zVpn=x]:;5S oU65S4} ps$A} Q$EjL{]jOx/Ɓ( W4󂡅8mVUyG2PB>6rڧ @'jZým]*pp-4B֏cKYCGߥ@n.jȂOgR܅<6$[!zX-MD$ Mh|70a|ruqNˋB{2|ʗ]0#:!tkB@ȿ^_=τfr㨠G.Db(SޛŨR\ċ+x[5J: |ltȒ,o 8[MalcD|Y%3qp9bchY'藬~v:l⑴jyLvI_=051e6.Ǎ\JvkEV_ aNpi eRRM7G vvvE1[w-|!ւo/Q/4t6-X_>*jUarˆF!wh2٥@PRkսh?Rcq5&TfӁR'6ӐUgƖ7O_`YR{S(PM&ζf45v7zCY^(nAyz)+0²QN8w0rJlSq>AGE琯] *'M3gXn$/L}QN8^0j'L]!0ý) 6ákQb}"hʊTofolٵzm"ɩi|QV)[1QNJiH}d%{V;o !^wSXtZ`\U #7k?EΫmǫ=2ldTlX_ M-`eԣUn.- Y;[<ewȁn4db&OMTcF/Xe5lJ*C fd׀$o7 8Yu겜#aŒ5Ur[z^h9 r&clV bo>aM E?!>Kע2LJ݂OOVx)N/9dj;j%|ng۾@&4#A, " ޺C[p}.Uǟ8olTG;:d,t~?W٪VvPq,_Y~}5q4vuԖw f[I.q1ʂ<ɿB*/:wqs@r ˣRq:5wqޒ`s' MDU6'FB-Hֽ{H`W)p{ZԎ2[)k]i~UJNd7T$W%l1mDILm9A ~rw?Mp%kEF-@ӝ2hޛ*%'j׭u7'윷.k]bfhf.7>\U;:oP8#~=a(dwZ0E7Z26h|@Tq^2v_K{#%(d뵧a_JƧQ(D qMq U1 DRІhk IIEtw4JĐsqOM݊䌧\=ÐDk~F `F9  P$b`y7LeO\5?U~QKP#Y?11o!!U.fɳ7. OG i"uZ"WϪ6 AAH;с~-\[ӧ wyn] #R+Pj頧y B@Is!Dy#`wJC ؙ\IчctnA&31)ıuˮ+uFM)DE,ܔ:Zy%_CQcr]ľߑ&#|g D6 luM<6X4MOY7Mc0*o_  N3S]Ngě53~ڦh4gVh}:y)QŘY28"xkh&ec`nXOس{(Y@-Zn0[1QB>$ .[=W` Oz5?=ez7PO}~ >"_)U79e㘤 / ^vl=jQ6p+&YMfnWb.l`N=[MTh!gҔ c[ yڦ_g7M~h:l B)U>R~QT H4ꎮo+_7^Ҕ@/{wd֓*U^{WfyQ>ؤuKO=~qwh8+*jV3٭B)xv`˕:Uԍk@̴Z7;FZ , 3cGYu'.Tq,z\j]vkң4q:SݤDS8O[%H_ˆSjOmg&lOPQ(`믍!)B総_ŽsosPX(nrxUSʛfI|X%MrP*dBi6zr~SW&= ݓљ0 k8݀sUW+7I3UKd.۠H"%? G/NB>+Ch;&W>@pI3w9+X1=-s{ OVݠ?ޗ õqt9c;6OsOVӟUaUIz޿"fwQN\0/ `X5BFLC^>Ldؙ`l%"3m@Y(^M <Ġ[,|([>.KrF=n+k@|a z HC)>Q>ڨm)@5?ZmWhaY\~wHLJ)Dŗ-ʭAThB0~J7W)Tt:㷸gY6#H0dJ!J';YJ)IFo-:`IMhd .Řl-$F܍k>+5{r^,N@mHP {<b;SI"Re!@0!1†^bgY9}Ď\cǗFWZpz:HVWhhQ 0͛fvvNCp_ʼ  NECfxnk.Uq(Hs@0Ǘ~U98:Z Knq_v5p{F,g)f M^zJ/OԢX##vw,~I]5V+_svYB'@u6jE{s/k3& iILKgZ)0-D,L2qY4FG$}cU>xަWt"(I'GGT]M(Rbb)9 ĮI(>IYPUxp?l<KZN.lp;< ?[g⑏09ȹ#<ьQIܕZ&t( `B7Nݶyr,=z'.)M0b3Y$bXko+5khbY^;W"Jv&_Ƚls8(ZR!XڻxҁD"0i@ԇWrH}$Ʀ3'Vx3crZ蒠-~k 67W8= ;{J6!EA;ɸaoqBrT|l?# n]>oS|wr*+A`'qx" X?'*~K>=*Zr(U >@[%%'.,& HRq(Hiv+hG=[FDFMS1ԄOs r;!ɽs]2Aw ~|Y JE+ѭ ЋlKcp\ѹi+O}S`pz;M~ȝW؄xn3*b]]޲qԩT/=6]f4{#&KCY#mM? D/НpUS1=i\wJ1~;z}2=wwNUcڴNYRe [d׫?C=3 C=QW=p|B퍄? _>^;YRcWღddVS 5vC8o{ N:9 ]F-昴FeAu B9? ), BDzlcYaiVvv?1>8qyD>Vrc@Cj>d 'R8\_G ?!p6,8DN#G1"6~ӷʃl7=ԸW,e6 L&+Q'= b:9,L6C}{|J g<:.X5ai3Mu s۸"y iOo^%RĦA&}v"mÈ2PE|DS$/VrBT^`Wc8>whf޷^V**؂Q>',vZ'@919fݐB/"xSU*䆆>2dw}+`. ExzՎfe!mc^'rLt G`΃!£ׁ )X]OZt7u-!5/N0&ۗ7':nʈ-vSֹ΋Oa*R|k۴RqYa=~$S`%$ZMn#Jo7X + `c{fI\ANyN͓ V%?9@ibSSwiwqc&#(2BYKJrpe.U-8HA@oA<ȷ6mt恻Rv51z2ZZٰ+)flK@j,o12k?+&gyvW)GKXP~ph6s-ۛ Uܯ؆xWR!ݵc61v6/Ō~B(5g KC_f9vl>$*5}~awch)+;J7쩰5Ų˱g*rH+ (*s+#C1łpo=,QFRD ѻNd`-U`巛?B&>;6eeΥ>l'˸+UGɭp!D~w E} );SړGX,[]\W<m6zݑ jZ|#>$xo,Dt#Xx~5jػ``L`RM>-nsc gD[̬"S;7"LwV9}*op Wڕbz'tv2-SSbXuprK9Am &}M;Fi\pimUϜrGKЌ:ٝz һE3ſdP I} .}{&2ʁ?͝dIk2PKI28aB,>~s@ֶj,q` {R;N/ء젪M i|qF#+P; O(옏#֚avh Rj:.˥R6c.i5uuA"[_JQ~ \Bv0ד \Ҵ,  FudD4UWުdWdަ90S;*E}潝 uދd>٠S{EWVmѴwN]'‹ږe"Xr6}Dq S` Xͺ|kuG &;SY/'bz phൂU=gr~r3E^Ti_ku8|WaJ'fhF eb7In 0U݅b5%X:1{MԘC#K-*rg R\oC Il*p \-eJuzc'i=q Wle(&M{bn](%#}!MYc(=Ѱ#c SD%?' Lo[(+ѬwEv Ez1 0R)j^ų"3_XFě UpZزSA' !p Hm;Yʨ4vd/ۦ["C ay:woЩl.l(忰RvΘЁ_ּ<ӱݖY>MZ1S×/n T] aΝocvϼ6R,m6C0f}-?1:E:EzNC-N럡줜s윷z;~LW?fΡ~P)!‹'am냥=jRvZbV2 &z"03`x>=LoD_90]^߶*ǿj#9J +Q|116iDWL]i7F P \߅zN?ע Fr܎r,'gL@ cی{Z}[9jXx,=k+ԛi0^(zIL#^ g}ͳ7K"ͪdyZ~LfstUX``dIqqH4da -c/gXeLxn`ʘj+6E'SC)Ry:=5NQiq`Ș3>wPmKأފIɚB4ۯH*S9# dKݟHE4CkZk&@t~%kx+kB>Y\Sٽg}_ Uc6h siu"D =#T*Ssdri`4d2])f& R!mB\/-䦪 !.x2)'NzNx2h- #^N]>ǧ<]u|Y[,os}? <=)h NHh+.lmSf<6 |eCtNb41B\5tu9}>MxL|'$-?ޗ3M@gh_CzWSe\5ke ϧ.-TBHnn 543PO(5owfSUQT-/ eLzp<9(,ja""ݙ#VÊ~ ,W{L)B=,ғ s$ a` 'GQ0MK)-2& iՅ@щG4@*H+%r 2ĬbhH@x8[6ͷLSƟz@hgy}́cX˼2M6$7;A{x!Osz/-&]p&MC+LNufl Μ `OOVs/mMF_KRm CJe*Z|*ڇ!uMp\̢P;ȫ(ɹ[?5(LZiS=BFܷ&2(M X ұ^%VId*`La F\6 0<>&ӭѳr?Wvn봷b?@5X3؈xj]cQH=K|!pعTʜp>1 >on}ibbJ!@7꒞55;JkD#tD;KEuz%zo1"/! H R!2d0y(Vi_.F tqgM<˚RmE_cb9Xk!$ @9LA\ݸyP9#㘭p3Ց5 2a"Ck\ K]LwA&SRQŗjYGq/OvgTn(Ӻ:v#Ϸ'7bWR7H`80m +y_n,E/PM [ хfjUȄۭhhH-]EWU6n޸e[S.\'(;Nsa(Do3] ns$p1lg+uyߪ;?1 V&_1Ky]xk|N3ዕ!l҄LTӾU:Ω,)ҋW.juL<~h~We*hH#̓} 3_#oy9'J|xuo)kBBp? *.S[[ԮɡIԒ2"wkpδ?, Jy$Hѓ\Uթ>v߇E(6=GAy؈y?-ڿÀ%#y2̚mԩx,g0Tk̍&Tw̿.6jV=S#8V D**bg#Ӷkhod-=F;<[@:ze= kVH&ˉKIAt͞9͓Utel" >vUﮱ!1pzgCk"x:[r?4S55}q*kmSzhA7 T^,O XSmN)aVECO#֌ Z+Oq6X3 ija(`C\̇tj-w~ K,Z nHޠJi*b-GITFH3+E.ȖE{ѧ'%A#esQ ׺+{뱨mG@{hpFh܇R6S+lf8ŧOgl.q͂+Oъt*\`(qь!#Eـ,xnYF 5 7Yޚc8$@ȝ~FB414_N+ ʦ X hSK=x8ix|h6A➍AmG >Y^pg9AsF]o]Ew={f`SQQ lC;L‘N= =}GIGnh+t4 .`wU~`W*)φn҃BnCXe%?\gfъvkeLzi.ih<Ȅ8a5_)(|DNwlB H>6OZy7f8fD('o(B¨FWUgas ,gpԗj_nYUU-` ^@lE/$425)1Q>dpYn>|2(,~BF|qn$i֑=Jiq*<8r%uGCL*TapC ̚MxiewgAtVL&dڰuͩrmziL*4gIډQsTOQ8#(A'oqdzq4BJyqRgF9UF\F:TTaɻ9 nbBvo ve`_ + ґ,^w4 b!#eOZ q&#-r^n9EVs-V/ə`qg9&ʫuAkR>#06#n^z[ ?j*РV~!A岉t3운w?R1V8Qqv0ÖYrD\ۡBn_ԚhVC=Ѳ=f"9V7 "nRc݊;iW!:zj63ҧQ ]Mu_Gj+H[QވT !)eI藥X;X@6m:b\p7>OI0[fbP&i(ʜM̞&sL 5qHB E\-j[m~ߕZVNKRl6NKv3lJ U ji,[3'$aɸG"bؽ5aXe~%KCw;kXAG%)!Oq['jE3Xs˼7+ 3q~3Itfd3¹_x .ۺ`͞E\g TvbdƎ["3Y>($3 Z$WW$4*쬯mv> \Dac0|MׁjdJX#wkK8lV*@GK"_nI3RsEe͎%HLޢ҄L2Lނ?Kk8EhW06;@RfÌ1JvTJ$Yh[+:pߪGL`z20ߓ#T(ݖǑ Z!Xoݳ21<+h?N%ob6y."GC,LJn.8Mmau>RF)az9G)zjZ `4RE͎Arr ~l߻ĭ>A oL}*lSFZ]ceGs {oU4]ꖧ:@,_dxq37J6 _L 7,6iskJCCvaQ 1zU:Tt,G 5fyAD1aAdٷD x9?REZ5 2oӴI_Dcw$ 'xUB* *,R]Jq;@KN4? QK} θ؁ OƲZzo4'x3~9)?G}UYEɴr7VjwW$1~ի0:{x|I4zYH2,Ţ lou(zF\S쇉oef9CA{K@k۹OwF/Β1/-'wRO3E47<ԩg[ڣۄ ɧ7&]Kb+Ժ#ԁ>][S0:C娉^FFy̑'v FTP[dV2vJH.Ip+\q5;>aY1 q/Z om;^ڤf JRNSq,gP94IV]JQGq]GKf(r]3 A"xbf9fӸ냴̷D81GtJOOA픕Ia ^SLEb -v ,Ɍj0b&?=ޤf"gw(tWœ%B:?7D;'Xi>t5Ba?3'-) LEd&HK4o PFC3HDy֮רQo&j+=ޱ/dG(p'7jC( QM_d%,%z8hnLα;Y4&gHi4[4bϢ ?*߾|SkCI;M 4a9,3c1Lik4߶Pj WlxOsdF{mr09tT4]\ٖh@d̍E^l [?UJst^rZ L=ZwNRTv45/no{9ҙSN "%Fij4UrPfpysz@+%Β#vMiE."+u*13 ܡilkx?M- 桷9[jШ{ b qqGWSCf…ǞYg0#?0L`Io_ !fzOL]$ntWƆ{y!<5"f 2{WBig K#q`-ƫn_p3A仍~<`L+$l-Tn/ZHͥ 3w 此J9(kRTP~IږWC"x0FdfD7 <峺~Ubo7^,zYu,Beξ-|7 0뇘^>l3ˎ4KyOqqV~۝C *ڍK&Y,>bRf4g/sgc9T)Nn8KCgk5 Lu{ 1)e:zUh_a}2\ΩjGx}_'k =  WB5ƃ]\jS7mH_&NsNC ws4֞J)50eNjMPSK OB>|f͌.ĵT&-v]ǢI@ 4nCu氂ڮ?x= vw>m8Zs\AϘW҃nrž\qUIVd.>M7(2~R#-Ֆbj&@Mq}W BIU)ZzW:Kfe)zj Fƽdaɔ(v.ZX0_C32ĶFGT)SIabH '$(.L5.y$o`! WYNə#bqN9us&qկ3I6M\H{I4xېR LD!vыp1Ʋ! $15\Š[Hy TdYXIqLa=VIbta1sȠoV'H<ާ1_s-b Aj ,\UrN 6qR=a$y~X?;$ICw0_3s\#!78*VٗMZ9O]U@Ś#i!?+%%M1yHeAq_R^n&HP%ZE+ٽQ&QwƯqB1ߤ%5d! +=VG𿪝w#]ORj+z^9!%/őeoe̪-^: |ڐt>E"L))^{ug -'ދШ ::J gcGY,WH3cl;'6)ܐIo`}-^l/׎>uj>P;XP|i38M57ocYDѼjQӕi6. ;9zux'!<~|8(PK-S.K;:iLj;sfB3֫S<Nib̴1CCL1؋y؏1rYL[&M+K;p5Xu<ԥmb*_ڥN7ͧ>sS”%v_sŹ?pk,aDdG>\2RC͉knodZȢiT`3\桑>Fqg@F kО)LTxfA VRC L1NBo :K'•Jx,ڙDZy IC닃"完p| m~XKSV$/kH@CBuP%w [l;j`E0!,s !TdDT󴣔}㳴>&'!&G_？¼c M@vCW3{dƲSnҺ 0W!{ylj+&&*׹ȈNzWSyJV3{] y/'xSģFpO,E_)[:?8_B4,Bc>6S&KPy1_L|bܿLzaҦCN?.G&TX2T)MϚI|8ϵE?%WGwDIa_S$5>N'Ll2)+CPOyv V#%Xl\֕/<&K9wk4U^! >ˉs-'SԦq]z[2Һ/Tz{%X gq9 )9 q]7 jP10&V.[ܠuXAL`􆁟I8}ua* 7DEL5dO^i>JKj<$+ZG<=Id۶4m@wBr@=V`w fhES 0UM/RPV5z"!Jb.ḃ-$z02.@,A91d.O+o2ddoe0Bp\hc$(ѱ 5M&?}=Da|t§ ]&I`Mk I 4LаtӉm'"Ǫ8߻Ȣk7q5ɝ_/;~PVc(NiT H.RMS2G'hBS)%Rg4B0r@q*#Jo wGj2K/([u#7u^VuBͭRnJ`hӝo2:m)<Ҿ`WmD9zcڼʳm>umDXһ'$>(q'?Y12iUJH;~p~Hnn&popSMy׶4.$kaNo(SexyDʛ&=Ùa^Z\K,ED'/~$ּRҺ2h{TnZ}袺G(F^8IyFu4/?9_΍S]H*ixS<A" y3~P@>})9o[- } wMԤt3d9:4*}pF@_WL6Ze6K5ljJ9ADq%BH96z&U{ ;kE/M ?]TFAGÍVPknKx+w1 q iб&^G;XK6OJQC~LőI*U=D OrVSFԲhD[[.PsZ ۨnX&?MW [m̻栊wAKt{oB/m^T9|]Gr[CPo,[Avoެ76Q9j75C&[^OC y7.̬cՌj]WmC;TLaTju>[xBϨ:Y! g/d5kKV3;uʅi5_us4ҍ]Pq%` ?|=e/Y6y$Nf՛r"(9ZbHt?BiC3:T{]鉊bCO֐2v$N;jpfaaQ nQ M7su0}=$dd fSЪJQJ!cd0K$G%%K m) v '\+!T\ضRQH @(-ds iW9յ 3Gg'$kNyO'U NOq%hia9mFZL(jqv%Wl޴A1\C;[~*aDmlC|(\iBF8ybjPVJ !U-~ c܄ξʱpevjzP 5%rj-S/^tR Cqԗ _nl#7I(jbtmœɳʁeZLU<ɠ/n m#Z?m_#zqrq[M@΁^.* nVK0,8NNw糚rPq*+ L'eLj~,z;|XEذZUՖB[kd#ͧH2N'k[!oVܕLˡ Bnmce|ю9wBjrcL #95!DmhİOQPZK6.1_0d C&~Mv> g Ё<\b@ .̢%ZN #>`cN|!a.DGӎحZ5faܳzVO>L02 8᠃kQ Ҝ`fK N}1򠀜JGā+`B8eѱ]u ]LUQt/#|>oH8ـݝ-H?lzSlE9[S0:rjYft?'Ӭs>፥haY &e$q}`¨mod; Q!òY'- /5@ad?{P?W@$` z3U|BC8܇\!8D zYWLkݢs}MH4<-. :ȖZi)3Y0eH{>fOG, (j>Bl-Uh}"18w}^D|Q)_LB_k= Eѯk"\@EAE?oJoB^<QzvsQ~97efWt N,Y${vo7Z8\4-n#zY^a/t֜I ﮀt!ĥi~IBO'0g'pg"3^8$2#=./!?~3a)R)Qs!p%n{w0Vc~% K8u4LJ;Tv]&oHTlV]xq{4)v߻>rK[=_Z*|f9V-íLHt#0Sj6͚|s L59s?ΘLD+jJ MMSmDA2\9q4F <¡B]m}nn鮞6r=yw[0y\?Q ~$w+ԤB 5a.(IbA˦ђLF6W'Nh \CcQ ÈڙSJfQʩŖ>0 YZfPortfolio/data/SMALLCAP.rda0000644000175100001440000002501013630677273015224 0ustar hornikusers;_?|<$SRJ62R2<4IP! H(yJdPc:ɷ~}^kg5\}AӁ0bX0LtÀapБzV&^ E3\ ̀O) q" 9ShRHf]^X&uGPs%X{ Pv)ʕUK+@Yq9Tu@eOc_c.Jȫ<PD? _kF:&Dkv(0vpt>Xx>S5'?IeJ@ɮP;#= vz)ϳ %kwӢc >K>Rļ}7XvX!$P)Y/BO+J Dǚ@Ts[$W@ta k~@x(xo7n6f D=Xit÷@81 ;~Hon]ye9gs@xw,G\ܯFmxqg,?)+ x DF@2`?$M''ƅ{@ʯxe%[؏%䎒.PBFe bsr`pPfCdϨ>PS-|eD4n@-P=k7U?Wuݧ6SFRe:ӳ?6:4 9hMbs"tԃAȇoaTm3xsI c/)iWTaeLqbDo~>ǭ0׉I z2FraPM05INaTF%uLM <8%Ql 8C0 w¨Ca!8S94ΣxrR7-PWλt7;h#hҀ|QV D{"M 3IJ]m IA %c[uVĘ}6Ӈ|hT/ AR-aܸq7jpi *IHlu+;xMjrFM0Z=im! 0LR-92=Ok<ڿ#M~NsU/хהSany`LGnA YW`V%lD6hQ7M.Bj:,EGYgdS$d4Xgw; +!뚰SM; Kx(sHyVy!*[㟖  ??I3J̶-+k]ɦHcj sko]3{UI)+Sc*vӗd~p6 x]y0''6=f;ktyim-Ljӆf/*{B~ :IERD&E]y:a0zG{fJ L]oaL[z?SY8-m!wǃ?]ٟ>Xwj %hga s:Ea7v#@w}`Wae$_LT5z.вlJ9n)3'a y~rZ dۏTnFx{"C9)&>gC2L>' #[ivY y. XG B{#%Ӗї%hwo)2"E:!=7/*!?집H_LxED'tn[KMsбENG"/l!Szmѩ쟿#sIO $dgrw"d m fJ4 bAYω__x#_袺 )JRC}̘tꈨP64[,PԎnUMl&i.Pu0ϑ ئM@{]}${`vy2hR&eէojgT_yz>*.2ep7X(ud[&[_j;/b:%5=z* y,> w=-A@\$,rraMu[Y5X\|p@ ,>+QHKXY+ԗe #O 6e_aEpWA:I;oyad/4A CB{$šGqP ¸a CGw/޲)qD = W ڱ'#zpM rXY44*}ydNy>B P7?Y$/>KH/|Es3On4Ij`J0_Wf,o8SOOOLOr~0ݜ7RD#-'Kack80߱}LU,ɱo~ S9[ݯq1KmQ9o5?W|-%^eMi sshoiף߀&;Pc`T^>NV6^LQ kzr"b;h%ǼVCH/*%mH>: #&jabfU Iى{e#~×#c}J(yob[4GZ\_ʇpY# Yz*z$z} sփeY}c3*N3"m;}O/x듒΂(a2\}esVBگ0B-׃h-(CgYֈS hDbw8q` g${( ٙkfz0HB1ŭjڰA$)9{xJ$ZI\t8q𾒚r6_baV6DH<އ~^b af ŎKze NjcŅu3R ujY]0%9hY-aAۦno\IeLb6P6F&u{=S4*uȬS|qyP]@+SOxc,=9x<7*|_Y~[y~o ^<¸ͳRoWvO0wsvy-qL?[~L:;>ʩo¢5X,yc ^X8ǪmgEf&z)} H\Ӗ[wٚ8 9Gx (:guR2=j?m.V[Vx|%O[,X&g\> 5߀hv,,^TsͬYM J{@rš lXZoCwk_as{,l s Pv^XaވXϸ=/͎PK/mJ^DW͹Q8PnkE~B |&|)F&ۅ o?JaG dezK^Σ'[TE55PS9 [[X%AXg ͤC!.ǟE _M7{إ c"ar9hoQaolaAWw᭾ 6Hp\=-+d`{05p sr0f:?Lik_?p4K3>L$y$ÜWxAI>sN}0;Dh+=?pcH_ɂU۾b[ a>e[!,2H|n '^%˽@.,Y(>QBU}XM+9kٵ!1l`?k$AW"k>!3nJF'?E_̗!O/QX=q5ܕ8W7=zؓ6mC싷nx"&IW"'>[L=$6ⴞL#*ν Fz8b=w`Ov|K_3LI;t/ &g 7K|y' 5C56`ֲktVrI>j;`)ʚa a"0&S~lh}#w)р=赯(=rBY28,p?Jeh{y{KK<εK"%ԷU^w'16ᄕ#'Qv'=6OEc=Yצzf: 2݉.~Űuj |OX-br rx݋~I=U. ZNͽ^GHZr<0a/6O32.~a>|giQ߅AaWQU#1)ſx:TX{Oۋrʍ77ʡ4 T"!VÓHF1? ݕwbui-bIsb)H]Ez^CcZm͐65p!Kʛow!$hb ۉ_670GC!Ԩi_^CFZzy]7̈TA.\Sؾ^%z#vũMѦbRb3N]馝KU\0bbi]DS+>`usĝ/"^-$h3E\b7uQ!1Ls" o+En= 6-u&v|L7g'. ZWxåƄLsD,vMԳTbї@}} OX HO$b^;=#,6\qm> \Ii:Yfßoxn7y ڧ|m(PZ?\[{ lTY~ {bӶEf$|S(*CUX ۏQ٩y2+,}x>++Enm QwJS_>WۧSPACMY!d{K -x@ 6Q>*pn/ u.d{@ Qq8^R'aFܧb6 иҥa"p^#7´`3qi;|to қîal7'8#i[~yy#S7 vs0ɬj,w].[nwi|}Sz}8mXz"N׾Έ]nscŔe_h<<-/ aHҢֱi~0sh ¥2ް(3_k˗:}37p_ED8d Y#1=1D $&l:mF,fa2V:F\kl["ZE0}.Krت*$z\mpFSFa֖@K"M~$ڭ o/ӹ7ۢ;c` Jzg,'˓U/UMCvJsSRJ̛1h]64#UӑxhTmف@L$+ aX;6"Fe %mE* )/ ~;$&Kfģ(賙\ b.>S#,*!o]%;ka!5iϔm/ t?槕q#b]JD6iX&0ғaAw,l I*X"ncܦ6}^4 x_=0e6 ab25!v1{Q]lM7b$IKD'/a:7 aG?FX%l*b\8(0{|A #̘|-fX ok/ddrbU_Xl` +rrYn)ާ">V%nX0ㅙ`)>u'YN)R cx! &&{^ظ2(랊g UIb_֌W d)+;_sN,7 0w2iPi;)Or{2Ǝ%w2PٟAt#"l#o,N3?f~uC؛Q%r/ϭc?n#;^uE[yo9>c1s:ᏽϧll׺u|뾧Cy|}{5{uZ\G\~mb]c??9~3EGwlݱ/-? L&6 rsr=`H?ZLB,e#_sptuqVqaA/_7#nA^n2\BKk(Ql&c'&{枽贚 2nA{eq/5Y-匳=_ y/fPortfolio/data/GCCINDEX.rda0000644000175100001440000005072013630677273015222 0ustar hornikusers7zXZi"6!X9 Q])TW"nRʟoÞuBioOЁ—IáQxǎe&}SV%ֵ7u+7o_"#gl9¢K4DdžWHqDu`iKavg 2_ glIaU(1:ZKH{9 6WBŃ`yEfUb3,+X1Eky0K 8"7J/JЎ1N?HC#-ۖ6,×_0b?ES,AjQ)hZ=(R. X |3vShIq!#橪ԡgT>alQ<-!!Kn Pe^twq`>!J 7Ƃ{`EE  g%1kO52FJQ? I$p}q7ⶢ{z ė6 ,SP+Χ*gd(űwlC8+@ɝrDdG#*-eKsL7:(W6oCO^.~W+bJ1a('jYW {0E =Tcb":HPEEeG?:'ͅ-hzh=ksV Q OفD>k8d0٦N ڗ5iO ήXH" [X0)rޕb1ulNkK"oHwkykZ o24V|GQ {&ʨFh&[>-F] 1qiǍmٹK+>5y[HHyEb8ZCAXC0Ο4qoHLmCE?8&4#U"[ Qf4%ic<+'@\+ e[!۽;Q m=!M]/BE&6/sջƨ=-&X^Lwҋo=l^GژTHY/T-7Xl$Y 7%[`jytz˽G_oqK&l\pg2ؼ)~1 }K~H1~6q,VXu)/v]LFPSRպJc߶U*;zO\=8 $a.?5f0oQ uvwNЙ zkYRRgTnpuHڤRnr\L΄#ay j__qzyT_i]0D''\bobE:דGpĽ .oV;`DG9dd~eNһ˝c RU=qu2Įk9hD琢X8h5@x'dحԍ91ގA=3-n9{Cɖ4E(>1QxMY8B.֦ xq=ui&sjJf2F2Y%x y&C1EV4Hi&A Ɍp؉yb}/f'vgHRpB=SBgdl[Z*'BS2ا&ʼn:"ꭓ0t-  ~:/l  :Ϥ$H^Vx1mM{۹83%Jo+E29R&aP3/8 텣к/GJZpolb@ods܁PWuS`זBM.Qb #ٚ\eITh\^=& 3I32P]r!3c,l 4|&̄S#  :-m 75=QFr_H*k>ꪾ͢\.!Q @Zuo&y}bk#Y44 S ]0afEx/|ǩ8Φ+uЪY|.>WZF)|XO͉if+yO $F1x)5oT2} Ki~['\6-}+blWv.K!ۏO]Un) d M}YTs7.AvL5l {6 a!viJM! J39C}8>65jfEM>g.pM̮!*Rw;6YX|{|zKSp%ܠJm1^ػ~I3hmD2NbMmn!ἣ3 (9ӳY2y%&9<ʟۜցc(ipQ|U'-M'u8ؿոv[ijmǹF]CMf+^jr^zq|hQ>'5x1qr$WT}S`H8G6&}K!IC癢H{+`4H&%KMj<Όkz75Q9bb.R:+m@7%$>e~Bře66˔&5zCäSa¼vW%pO5Vq2*]M$W,+b+P cZEoKFKȘsc.9ۛO{"bC+uᮑq\-jD;Rʀ) 6\=*7]oͶjfT3}g>f^url2X~LEsesIqt):Ռz3l7!~Z <- !@*Y7Tӭcl8V皱'6w Xm;ɦD78 墍LΩCD^d?X 4(ߟ \p FS2 wz^$*S :ֆyy`, +SgHpI{u̳Rݮ+rV%͞,u Ks?- ܭ h8ekW)OO0NUIu0.. ˱GM6 SPӴ#̷dGx <4g;tjMZ+L>͖3l=%MK%+YA[}Z(=8dhhK*D2w0|CɾӒAh|[Lf& tõBj$(|wRN @{pgo*)Ak}^TBzƪV,c QNOԲ% oM}nsΙ0 BPb)%Dgz-=$Yʡ-2Tvt:\}q0Pc7VWZp!%n^Z,b *`VuEK|TC>g^R"PY t]+izػBjWJsAQeiZKf.z10IgWxe> I|:uA:[S]n}+!~^8=̆P(Q`JvZr U'X'ͅf:Buew inqqt%ozLhepjSǟJC-" WOImmT:Ji^řZD ^}r4/Ő4/X3A#.lBYrCښHINi|b;Idy!mϞim`I!D!?!m,yڰ늩tG;ұO$'3'RgET`ޓaчL'$tӚ'&'=);XIU:Bgȃ rb˱4cGdkh,Iu4VwEAS\mxd>:a$f{ƴ\+d=҉&x'YYL:d(4 g7sG9d6]["DgK`ncZ6ɉmTu8of| <^]_:<{Ƞ @d~е$5,jQՊK=he9E_Uۭm\>б<"PNekBI$~b ʹC/TX ^1Cmyq˂p࿗FL41 _mTd:?Hpj=ʂ H%l0CUT36Z vծmZ1IC! ܤ:RdU KB>ymLJ5sy3`(I i%@Pyx>f$ʦ? ]~ȠS k|7}w)ݪ%{}/Ymbk]qVx gz@ ~l`-ZeR/^jֳ۷V6O ~Dn鴳fh~؟T(0b\qCxr1s22@_~hUVGSt* |-P9D4v,@C ҴA}JmD%>+8mBJTJD!j)3)WVQPQ5 Yf1ˆ!6/o~30^7{[CFƒ5Q*ֱkf5j{sMzb |SltpŰ7/]PplC'$rU̹N@*G.^]ja0NA9T^f,bcCL'-o(Z75y~< 濞_AۡpHqA ;#;@&orV0Qw]QI\Mw)N!7y1c[SZ9+Wh DeML t %7< 7m? ى}1~kzSW#?NJ~zd] 1>Kk N=5FdML!-qe 2,2:s) b ./[1H?4aUf@9G}bHns< V{ak^k$RZ5;sSGUL׍clyI9+&KwmJTTA?;lxADVs xZ$M+f(mA)Q@GYxd6o\I:BhyX\6/_PcrfRT)#ۧgk~X⯒ˮtBrL~^SL\LV]13< 'آH.e*sp7 b8cqqV+a")hzxZ틡6W)QG!̮j8I`3|H_K-+hi=&/3MXr}x.'}vHĻ[la3s`u[HjS&?ߌP'DU {G . 4=fm] sxֹV\u.lY@> ebaAU(Bxn*R5ݘ t}c{%q]82>+6jx)l:8,EQdmcgE'84ojejU6\7Ќ. .D3ǰsXf˂φ´G.Tyexh ;q`jUyrXC|e~>:U$(lH4lUKcqu8NBP3v">qG^=8+*Sa36?Yf'c.0NųB}Y\Syd~^K᪒Zx1yAPSI=ɒ`klX+AWj짿 *3Bo>Wt\ " <_nJFzMƥL]Z+IINbzFoDCPKx-DoD 8l! O} $zʦú^YbABk*Y71nypR/}Q闞Q|q0NJɌXY*-z@U]%\cipA*5-_6z #)#8"^Bx&1V8O^n}06gm[gI 2cLG䠤1}e_۬B~?t VfCJ#2 ,iv|E}5:k9|uB1Z-pM@,lM%ʗ-j&> [~e?wA]:mF Z4& AVj!g(JӳE\zΌca@庱6ktQČunZEl I?8ɤGOJ/+^,9WCNM5;I/F!$=]J.%m5wnaUnA=^u-^7f5N+}q??PZLJk"-]OשVh&-ڷ\F a5T.:Ky 6C-jzQV^sE9"K@?'ҜO;N1k͌ԣMi.ʲx%qsP^h"PS3\c ^~\&rHmPU:UݶaD{b=,)}؟"4@f-ŮGPGe?O坍NwjJ/V"Ԓ{ So.ipDdEG^O[d}7&Q\,oȳTK8 6p;+.P㾧5"ML'>0O6.%ox%WPq?cou1Vr)DW bwNBpW7jՠ)j9ge;It 8|u[T BqTPVYNB=|.wp"J3ګ2)d3 %,`3O P@w.&bies^5Y2pZ(\(p]4)rL\VT]BHo4H,`]ƥ&T8 U S1cȣc3`t#9)n-Oӎpw*53 B0*ɅͿH2s#S Lj\ 3Gp  DcUPt>]kgVim>tlp( U*Mi&NNp-gM]ZM_JwBFGuNKm.B+OV^XX,Lq4:[U%H)Y2N go$zbXWPOv]zF:\SZ@x&MB\U)1(7t4m|ƪLrzO̶Mʃٷ3 ТG,Y pMM`Y,K>Q_my8cw|pn^Rd,:-s@7#l7 o&d9`Fi]%HA(QέsqY'}q+/FMFi QqdZʱ9fڸz4S+Ϋk7Ľ{Tlo7^/gȋL?VDo#V7ƍ,&Cl:me-ApfJ%ATw;R=M .1}O_fpp9mr%-711f΀= xaa˷)z%NL{#:G4ԛ!fw3EIz`OG;'7#aWn`upS90VhX,wsAlZO_Ek9KPVsmZ tDaN2Dx4%F}^xdȼwHlJ3a7䩃]5w"tbܓiis[SC@cC>(vndB&cһu*rȇxu@јov=\p_FsiG?hN+Ce:JM25%>О|V,ӓVīSkKs{ſA̷'M:WdYؐe;2F䪀x eo_ϣ-bmb͘[{U"CHzņL6\2VPbCjyV7!@#$/8%q\Vm+i>g*J] h DB%2z.qU;k㹕 KtA,z<IPmTN41:;1mIf(uHZxq& IO]%"ѢUO`"06zK,IVauX|H^"OoSbYgTzm; I"j)m# MLNKg}'ox:i @6nBH*zϧ&OmvZ7 ]`8!:**:@bD>1l;X[a~)W5܀=hC&3IWՇ~ 7gpy~\^uA#^L{l:Z^8(]lts6s!ꇑ SɖϞKC$))1*\p v!W32iI_B]Qòt͡}ыR–i!c,>髚6Lr[01*Ɔ>ZI1ss5{4@ܪRx72})džlNfJ0-SEfv؀nu}!W+J¯a@:w"@ Ya֣ BP>\db9w$RJϦuwG\뻕} l?=4>;.[5^='$l@~OLBηW/Dj:aRL9+*hq@kņuU4~Z#=hϠn9vEbTe<=\ =Α.u3;ì0~Pl=Kk%N> ஛nt`һmz:q@oA36^*ð R/茎 4)+dC(@‹Qx=P+!Ĩ/9Ӊ+hPQwЙ,;O;L+Lp e! s34}n8|^_*,ґރev$9 Y`{tK%P2:Q"nY;ۂ=GAlaǷki~'-UviyϢϝ:_EWTșaވ1}\rHr5lu#+mKJ̄u5f>JR7Of?70Vr~ˇ]d#;.\N#I> TFI=:WZi se֢yͣKd14 ʼ!+i-oFzm=I3PiYJs!t V L4\O~XHӯ+)ysVo;>E*E?>{,a|*FrqyO pU5t#WH/%׈̠Ц~t@4z':CS +$ڄheM /P)^$΋W@PzZ ib@zˇ2p 3U쥩R2nrq=E,s ءPPAP\EI gZY'&*S_$?\B?|iFOP`dk'ۿ@ hϲqNrx%LMDB_YλYraY)#.ަs~`2 Y:"yE, xKԋ#s`ϥp͵K?~:(MLkV  V-9dyi O+&Qc^8 SNVyfل0CUziF?CA2K!ѭWnJ`2<PPj hEE<` 'mȦ v`RS9͗cy t3e}L7mspT+FSpF(A[(K!mr蕎ImqOs49oD]ЃJ9myQ`"HN :jGyN=0w>%l2 lI׭R_zo:kL8 N7%d{`Ťߢ@5VJIAu.H-zY 4L)od@%[ΗdJpOF],/>} wsN;Jgw5zG`﫯i5FKחa'f1~7%IɧLj[V^xV3;,f\l2Şqγ6ԭ+P#B:l }ͬQlAU a-؈,mn E%LCL?ۭywc$Z5EBA'5Y|^= :T>yeL5gU3UU"d]:p^iovgUL n2^UL(߸Du9;ttqoxA):rZCf יL쩏\ 4 T}GgUi\26LdP3c,T[Fcʜv!Xx5e܅ Lʫ̘wὤ%[,"\l@1?/Kwњr/ ΣYUp pGzs85iL͖{=f6ap`6 sZJZ F79 񓞆&RH?!iBb1>=iΜOskJ| NXzuX"_S;¼[o@pXjbzٻz?uSl4jFњh dk#[1\,4!%"WeT ֕?'|,LB5nA:Vk@'&IՁ ꡚD<1 &9W{=e+QI FN-f1ǷC~׌I#hrl~pX"3h 8eg*'UzRm_Od1y̔a *n'l7],Ýf75my;PDg% b'?pK\xe ',s"3(_[a3f[M|dy>Xd7xUJARxD0F 'npfDg.7)%~ʤkF4NdS%~_vqD~- T:o[@6p$ڑDŽ;R*=]I @qƸ Ygnpg?7QJq  "$FXg &'H$=q2LI6u;*NR 4Z)*h?s˳$Wprk~CQaT)0{A-u%/l_!5֭t}Hb >y8s@bsK%Q13W;$\e"Ø~>>I*T5z+&XanA?r(``n#9Í IpyrA™e .#|>5bGqK?Ųvn$@MP 1CgS=z˭ ՞ҒioBFQxJp ˛9UM@Ӟꗱ|o7+RFa0h}W=V6Wig>g% \UAW?mM}.P*wʘtz#Y¤m<:8'~GIR$xb3MʻjTm" rj'_/]EG{~+cݑuY H)픀 WH c-]2ޒ$idYUM.@i&AٰQ A~_k @  COIM0Yaqu/W`ly5tFH`}Pg`jw<#`dC6kѸ#*##mk GxScŪ`1侲^Ug[nr,hhsB$%,+ڟk[3>%ɾ0Ƃ@M~/Ͷe&;! W›T:y+Y V; AK7dLJZ$`к;mk?R9TKh ]DX2TmQ~4{ê/` Wgj6*]m~)-d+rqoD{1@ܤXF!qzrE<9C!ؖ !aGYX3,<\:}puuӈ+qV_ҌHy0m[{O#}"SEfHd x:y])\߰+Zt5ȑ"YBKfkj GqW n߱R7esVaG55o( !$N@kR62 ݱ?>J,?9$6s)W7Bsc#1M2if~1A'l U2DU=1=uVeHei++șyuJ/z3OM* @(0¦Jj@"h[QJ#]xmJ딹0->,Ϩ^YY 1NR0 huEkTX;F6#ہ5bÄ"&Paα~ cɬ)4+ll'8>\}N;RB[IX[g@lgjܜԻ~QwW쓜@ufMZ` 0eVuZr[=R | 2GqtW{ Bٖlg|L--#u2xȡ)X&;ѣ6Kl99{Q6?IU{J x9YWV3f"`AAa{#Z\z8$Ap]/+{5lI?DM5n^6B-٘N.bG -c^[BwS֑uZެq|4ܮ(RrX'ɿ+A#q ]+YpdX`n0\cef811[c/{jb:ң4~gzX̠]UQTo$C^ֺFV63%ͻ=OYkaϏ O j֏祻% ?Tc шQ@.dCBm.;aY8mAH"O ; vD'IkF\^FdLs'Q6a%ZD8 ZX7Ӟe/Er is+x)ːB k7ةc ˇ+<:Al$R )0^ (d1. 'O}o9 {q僜jܧ4vQRNY2QSPAbG_dcK7`J˞^=\uZGdؤy_)iAU!Y٣UKSWzmK$-#XuӉTQ'-C1=-|#PvSm~JuJMxm͐zxr !)w,.%ht,M;wЃ&2ò@*]GP~~{y"qFTEw&zr9<̺l=NwvmTw9ϟb J/w($>yg$〨t3(8_Uۿۗ3p.)ºr/"e ΌaT3`&u9Ӷ=I+>ϒᶼaNDWkz(fgI ̓[zvBOaFim+ аir}hpld&:^( xuh~#};9̥A- ,lRAz+{d#<G.@Kh. Uiyrĕ9sCpͤJV\#9[+myCa ?K嫓*VoNC(ymͭ4_. :lMnF9dH8E;ޥen,@ 2;:Sn]*ޕ\݆1ڻl #^~U+=gybDAw#fvܗF ~q-3Y31]F^mn<|!LC)p`Cnv@tN%@6B=j%1? Ax9W b+,+j~VHV0ր.~Y/hT­oYN*#CrRݭr3qnNR⬤@Ѷl16{5J&y@^Y Jzm iu_:xe5r_"8\ dP2^E##1~FWӧ$b,} :QU f͢TnJ~lC1&k#ʳJ'_Dhqqi9pl_=1Re+#w-V01B+',~O;|E! }W= VkDuQ\;ZJ~J -T3kPiV/9M}vS@D>|!ՙ☵ Tvx]u& e}V~3Ó/SϠkȸyQ̈́7Qq2@#B$˧.G [ehQB1!|"G?^{sBK0"=Ty r/Q=-qQn+1]eYKb#@8ƍSr~"#qHfsfo; x7L V͡!ѨG~< 4|szH3vܖ( |EY2pce)-~cAm(E "'] :DN )}4p.+\Cɘƀ{ludS5@GOochC⵱Ŭc7W^i'$Y8̎6x#ϵ-`U~ysBJ_x/5jH~6>0 YZfPortfolio/data/SPISECTOR.rda0000644000175100001440000014632013630677273015413 0ustar hornikusers7zXZi"6!X?̒])TW"nRʟoÞ=(TPRb>ZRwOfDK!W1[ݰ\[]RLȧW?pvZrݿX#6s6Lݩ2#6d gV LS5jh6(kM;=Nӌn ͕>s[Oghxl,`v Ly֮}к6Mˮ#C6#}|2 R8Ch Uml7oj $p`@)4}(突(i{1viZSP~@ÑShYh#xĸ3WIxOTyp_;qFw>Aߛ3FдEtvLCb Ntd Y:y\%[Ri oSB~ta`TOFk7lo}S˜]V5Tb1O_Cп?[jX_EČX1λC| 9 %0BHnksbIKr:w8OKs;1v?4Ԍ#X/M\DV ЊWVzI8>,7} ރ{+;_o\C&Jvi!=ռf3.@W.%1|_utT#Mr(%$qsOaI]"hdBUxFO H,ZKՖƅB%7љT0Xyv&I}ҏQx-.wIFՎEl5,F]]J3.^CӆV9(T ?uȠ Uhb彑=hF:l$n ' |OlK%"~AI8͢'x n\~}PEEB];Bx`ݽ*giWC۴\~]6C,L<7 P46TgJD? ɢm[cz#cVDvjE2UҕZ4*j;fg vEvHx<p/N| YV2AVA!*1u9J9 q`INP\ˏ!e'Gj$ǏDsL|`Ai۰NB5;CW/XXu_zI`Qm-H>Znê<9h _\=*9x蟧RFJ-?("ItmtaԲWG#qU.І@ G38"r3t_VazEL.{V{\|ϴMP:hAGotJlrX (j^t S }t.TEinUO_=IEUV$88+qwD]xЦK!j?dd$@ Pxˀڊ\0U__m}&br]*w@,If}CuO{P|[32QAW qҥ!^ D$ ]WCW !Sۜz:?dWLnXg!1”`_/2xw1T5DJ}KS:&"@m3uEz)¦6mCx&Z-4- &/gezM[TC 5ٜ@TD4DJ|Ilb D~}|V ў /IvOR++s+گϡ'U1bp(4sȟe_rDS6rUErWk䌑O+=xx<#%R|5y0&*6'C5S04RM{xv'Bmb4Rplu,AJ C`.lg;Lzrn Ez ~k$0\vFE[ey;)o;D)H`ւdd_Y+;Vp3$|yv{Դu hDw1aL!IS':@0 6YPOs+Q VQif, J1k7>Mo9gUi {F^ҨLUCR{K[b@_Mv1g踭.ߧ=Pc'T2O8L/ c^BD8+<ՇyoOo&[X$!UFNGCEnȣԎֆod't\y$0 ZJ_.igDXMs9-M/B _0(@h`Rq-"Cܞ]m Mja勉-MoJ?`Bls0ǔdۑ̇u5N 㬒kc" 湊/5]lA#bqaf!'즕NĮȦ+h@Qkn8,ٿh8?U;(Ny<֖p2R}og跏ۿY: d`dY7i˜`ЙcP(tl sX4xM&4 z}pSIYQLopن"& AJMAd\$`/Vi%,ka^}d2A߄ jbpQR Q@yI\{#woy6B -QL/ MUNrB& qSJ4X7)ߖBж r+۫!\:O=,ݯX S/ TupQ j\ƆLT<ś4/H&B@b˻1-uN>"bDƚXtQ̅=U{o&ls\ШHK E=B/P 9!@{U[e@XI fS۽g;Noqgb~r.2iI {բɠ .I@On?ٲӱRLj\ʆS(=MRY<{*u:i){Vk 1A|/t\C0+}ٓBm ~İ iͺN u0Uǖ'2d90 1*0wA-(ly8qWi#/|܀ 3 nr$Wu^l]fEՙiJv?~BEB9j\0 0X3a1/Tچ@=TڶW M͠rBF7_6M%0)S\[Y~>u (m]efXˋ&Qݢ*&9@ |imm %5\NC.S8 xnmMMdǗA~WzІ}%RnĔSA{0?n+~JqaɐLBC^NalyV4Y $C{PjVhzM #4-f ʲkѣqJO'br>G۴4y¢kޠY/^ fcW7sJp!t2iۥ G8kgD6vqHz(,J.Ndyy͟@40xs@)#Vu+QAk雓2%dHڧ|7Ly 1|,|?WDz\kInƫ1`"[%]SGgnBى͍(6sqV yՓ\d-?Hg9s]Q'-0 vڅt0YZm&[ ˤo!zUg&UM9夭T˄fA7+)L`Gsv EKM6T>Яhw!~ Zy$F4f&GӤ_16pAYU$EX";%7ܒ7n,NaAր_n<+zZ-5:evwqFt,ʓS_dw_z3zYJxIrOdzs@?_uKnl٘ zi;U& r.I|l\<ƴ#Ј`.D;TEBhvu([;H|' JqK}ZZ;: 9 Q,?.pđ'R7dŴγ{i4QMT|,PM?ҧ OVyӳ"\Xء58j+oa M3&s|-؟mD9^0gQ\mTE^e'O/L b1JDY"̱sN9PزYu!05$aE4PrUڹOtvg%3vn+E?)ZJAWoOj{`,F6ԍÐڽы @1a @2c 7? zs6CV\w+w pQ;ے մGxmJÇ?#+:ԍ́1MuȞ ^iMy/UnPiR}Ee4,>#w:! 8zUQZ/ekOs >Ȭ;+6P*iDtGk;˝: (1ܟ'GaLUWk^8#Y m,LED4_F>ʟomV3KX%H3{Β a}˽;LlhsQu 3g:_3rR3%L3'|'/4N`giڦs,/Mq9/{=X\YYՔv"c't׼S6O<)7KNuMZ Ks1Ƶd@ {)Ѣ׭fY!$mYVfMr~eULU *^#8Du/=UKiwwO uLhm meALlaO!*G܊(ۑ|_ƅ[PU?&k@&nRH H s"&,VN\uJT] DD=}cPr']X8,6g_vR5hL;STܪVBz1 sכ,$.㪉P[|+a e8C:*O Kde[fЪ;y-6r9rbsОсxNa F,VwgʫBt>#׍. 5kS /-Q,O<瑘z3=v/h}%S;w9l&;@r=c(L|YsH:{ BgߛB 7Gт?A+mޥ6oIaO̗lR,KU-(6| v 0·.|)ls5HἴWNTSi&.1N:A&1  5\bW/aTZ ŀŽzGY dXz&1< oU<ڿUʟ΄?o_#R'!ľ:ͫ,E0$ q~wEqix䖃أaC?kvP "̈́ϫݭOxV hNl>Y]>3:&Q3lN hhP._gX4 4Hhy4rkwRԮY _KO3yrUƚ4c;0̷v%S tc<SX4@yv<[UG$+jX\wR5` 9ק1Wr/֕DjO 2%eIB-q^78?ǰ7uʌx~B+\>kkI`0n_fa[(˦9PHkpJ q]q۩@ᢏ "qrFA]+NF >xo?񲧟-#w!!逥ܸޱY| =FH |4".}pP5tJUzÂc B,_YA8H|4qu2 IArܚ’ocj*DxibûDڬ{g AIR'qC;zxJwf> >n=jm1ʊ{\5-f#G5A0]X#_iؐ".nVxg]seA>" JW!iScc1ehq|vPD6&Щ0u_#s: z{\§]usĤ3V#x¯~PVާY#wdDՖo71){\ /bٚQ:pI45*WJ̻p)ekM7ٍ`ߠ,v@?7Awd 81+=K&YNmIQQጸ|)% 0Z:`xDH Ĩ6Ar250bf:߶7T!^. }bfzŞ,wm +2 ˦\ㅧjCŖ$"謲Sȍ!C߽dj6}ހv{OGx92Kyo 4ì)N "hwD==x RSD[vqCL'{tAݦGtIrr:ZNHaqm׶`/jӿ"j, س* 6 54Ќ66":e8gbac_!4.BZr~XW|k/I] KPO>픥SGk5<e[ i J2/NmnݖaϜj_ 4yfjҊ >CD@XC  l0x&6V"YpN{&1h=9rqQ ߰oU% ߁8AG_U%8&et5!;]:$Zly ^4AVC|hGc9'/KЩʴݷ* AYR'N_] (Q09B%2('6|#UƆ+cd37cTI-UaNř'*/IE )6~4DnelKi ]㱽1Se%>ϝbp;4uq0\ $?TN P k-hЮӫp˰$ȚbOɤU8g72,or;{am{y/u_6u8{;+"ôDq׆g6 ܛ,Jr_]I,Uw ΅DHbjj[K ӱ? 6W\S ׋l_d>B,?p[Z{9yeqjFq0G#WQ;:8PAQf? Ac Y.d&P=iTm=KetpOyr| {0د_I(tїJI ؼTTBu%o3 -+\`]x&> fADrڅ!7:I-HrC qeFz%Ì91^ZT[-8R%9OIUFu=Wls/h$!wռItA)]oƣE % eiYEy TWʽ%;By6MKtnL/O?}4.Ct"< \W^jtI'@*ՁXv6 6k +՜ӇptVAƤW<%Vyi*'I s4ɕw|ew{eiD!xaT Mm5r<7/yBOd+OC?qIyYn6/v$LOM[ssQwEu`Ԧ ;q2x Ct^Of[{X+}/5jC#ƧTqoGa|l}27L7$UE[}sg!4pup1Eؤ~0+"AtXLG;y5Oj 6X3gO9fPjpڪ$+ k:1HȄ![&snOSgkh4Ұ}d1BD,n\1Ek0aĀ)Fs1:#,oX)3lCʡA?n騼Yl' #bײ ۇ0i@u[87 μ!ȸnv3Yir )D{3,6N簥x wwj x&߉;U=6][CZd ~&,KaO9q\%p=?zE*CY|ɣi7S+Pi>y+R륭P V#%}yS>ڒNN'Gy%m~Ā8"FB^pu KjZJ&S{,˶bNg=o ϝ᧺z=cĔ(6֐]BV{ь$k 0Mh"}?lhO~ʊhzaw Mﳷd;9Gj4& ZbloƐ#s$1pɎ~-0Yn@gp@iDCb@rIiBK*jcE&@k~h{$*bܖQ,FL1$Mc|--7b.d8t2Q=&V_X1_*-l?B7`|*(i^S 9J,X5 t޲j{a)(@:Կ;Y^I YZ˥Gb6E1NrǑ(}GAoܐ7Ѯ70$ S#^WsF#E7+ރEz~&TF#Qs,x2^vmԸLz'׫ xSw9zʂtGl ItV'YlD_7畻Dl.5LNa \)oS%0? OsĆ՟@~t>gwny(e}u{+,3Qe$b9,Lx3uC1ۿlX(ldϔ4[1Ka$[(ͪ9A+Jq54Q,X9qʀ?12޽#|! xY l{h)k[ tRifoQ$1;l6E+gF|Z)/RR-w7iάnV&k޿`)lNK`ﱟSv d72 DL`17fEң" tIrtm֔GV$ S5Æb:u&Ӈ]l/ &J#%N2S{+C tS'&q>!붣@ds#̇2">t~={ OYKq:)CL.o+}&Ƨm,Eb65>t|R:|"$vw)qm@Bu2%666$KP;sЦ8*l[ Ƚ[c j^yBF~I&`&d<>yPtja\{7-ƃ:4̺—.3yryg.G'$v8[#) "]EMh"ć\?#(M y`}s 8 ^s@߾, ]SB/p/Ϯ RR8W>Zu_ 7 D!PkhbIsP3Sؗs!_lG^k`ES-pfV(=sgEm}Uզb˺/f#/Eחiҕu_YnlUZC;=g1awW3n%O*ePfpn _5\ JO<%衂Eg>bfиpj%JD̹گ(I)6_U3+:;D\#̴ٵ`[W-drxoP_kz`*몄?XbN'E߁29&M7/~U 1\uSb!P 'mvk|+M.@Y&.[T -#l`aHw@>dy7tv JyۋҵS\;, M Cy,]3 Olj&\Hސ($A=ݬF8g[k04\(> J׀Mi)ѮFo;*\yzj) <߲!^΀mNJ7kŤ5f1֫;2kDGBWdlH32ۄ.f H[bjRY% g} \sZR7K?1wS73%%X)7;RY%&]/FF=06IBprR!-L6n1B.}|@JٳASnk$JpwJe:|z)3 2`_(Y`3Zx̸ _6$~I (G-98hRf ﺲEqd\Ag%wTl+C\Nn1гeFPʊ 81V^f+s 3\+pC!sC0̓XYaO[}Np$Fh "\w)k,3|C_NǴUqPpo1e`.7!ۛ͗734ӎ d'~hYkz?>*`M8c-yoX` SC|Sޞq3)j^d sÑ{S]EH3p:bU矬*P#I;yMT9ݳ?gH،kloڌ O)Iɿ/cs(3Hn T,^* ҷMg$譒QK03Y9q-@31^ ϝ Uo$7> S&ucJ[_o o6|\?cʟ-'x+%95^[{_xJK@ұge!b1920?sݥ,4*›'[ *cBM!>I'=5lik+fc0`"L:Q۷u׶ Zio>R}IM6ZtMduRqb|,-=os=DqNTO\u\lk}н[y%^XjUQ?HzapiX*`@j~ QWoA> )I{y~0xu~>(l"/DEC:/s{@"TwܼFA$ tzՊ,bGQ@W[,{Xc|p}[v|/s̔"ꂅZ";C< (R^2Y8Z6Sw, ve/I6}s$ЃNWc ' 3Hy"ԓZ םAѓ>3e#@n4n܋,ČK7ϐ^PEK}&i[ܢ5~RQz T9۔i&|+Uq]~tA"P}# hP\[F=|سSև԰d>c@2 fƍ!1y_:NtP(","mRhaGt18Kܬvw}l@/<_+rL\ڼE'Gᶇt<7_$;ƒ܍3l,Ĩ!BwUБ՚Tve/OC'=Yn=f Yj^#"4x'u~ߧ~q߅N_ = YZ_F!\,~ 9Mp oU< WuEHҲh3)mB@mi^~D skd3TqﴴE7ޟT8p_9z.w1U5YRq&1~2 2Bhʡr|>%ʮE\u1ƒ|Rpbe~wnF/GN\5E/rB!_ðyt(,z&_6E|{ݒU'k97#;? 5r|BtX/Iy^MAy%M7Cbr҇i+wd"c!] 2vǟDLjIvj?׈5b$xAQ#FYRho4 <9JQrP x3?@|W75~Yp畴?PQv\ܯKX$+,>o(-{WߤiH%cM_(ջ[8BJiR,_n̯ܽI.Pl8(\ffLzؾSks*v"b'F&y}xdF;'LDU{cS{6XPpE{%Sg?-/z$₹#kS(FVAwlW)O&uzԼ"[b\ - Y~ 44cjBwPOqa!׫3{VFA*@L~T%,$PM`.~qL.u@%WG|KGaVQ=D:Ǿ{~ō{bD=[vF4o2'z\.鮡%q0`ΐ"_n.2`[G~6g;H@zQzנGcw˼0lRkg<a.Ц8h8t3j*PSw C&Yn8Vlo8LYc,"+ ਫ U @6]}C`l ODŅCoK~)K^ 1(~-T2DcM؆4(e+m9DOb=ysjHYl濯r Grs#MF䴨RZTYB\xv,g$5t!<;̷Vvk5U{`-stgqӤ|GmCy5Ѕ@! ঵'klwS5%MRr!a ];Aɩ:9e3>-#b -D- 쾘Rm]^ whs{M| #i jm"DHۼpĺQI$:XXvXf%R `;鲁}5@ؑ l$#HK%GZ 7HsC#BxvՏنRY$ Ay'|-f[$mLb6pq$iߵI)RǩZlo^Cvii8! ZJY*D4`#tID߉w'* g[%i@afIE  Wi@kU1>OT@P2$\hlUxM[3I? q/ôU? 2i=F]1`FʌGH6WФ[(Rz,(0tT<Ā6H`PUVOCſ΋+/}Z؊W܀~ge4{QQN^HORSKq{nCrw)Sc̭*wnP;d.7q ߛ^`m/S?(LUtV9/ bջ7 AWӞPkؒ_FQȹwڝk}9NJ4/~;R6sF_9%"X2& ,anp3X1kBD`j]A(d~o@A Bcw2CO}a{JJ,kkP;b򀫨LǕZ*aq樾b}X7ԨOWqѮ,d{ Ҕ뵬ȃ E h ;(:2jGx#yO}Ć07:0c Bs&Sxri5#Fh[Iq;`kE.6"Fd__7r<4NI' z Xa#4; S&c4Xy]ߎ#JXu XW 9,mWC4햀3`_ΜXqɓuUK`n/$N>Q!@$ DHI|J@8)N#$t}\漷R6ӏ$OQh0BkE;/)C9i.-&VxO_JmLݏp#ԵA^;u/jK`b@"W m@&'l?۹ ^y(ڙڙ_4XLmD4^g޼G|,3wc_-av )tꕛDC*dơ-||dh1XPb, S&6d-餼]HHRprN=λ^[R:֘8M &ޥu)ԉPi;H뚬_Pv˭5$McXZco B,3?caEUn:=r$K`HYSmI&Bix *TԢY Ca1'vu^N.2ˉ^LqHVcŒU^[/X28RWͱtOP$G;0o\b, ]!C[g5xi8RBB"@ܵqa5asOb!=yӪ=2`5ׂz {Ũ*~,]#, /TtweȤ㹲`YN%;h^wkz_~`N;%tYr=u'U@LNu)-M%CV:7ڸ=QJ(JS:M6J,wM.3=|&e-=q۱9Ĵ9 FC* ͝qiz*W#qԂAtJi:vlYk nRMwy6µ_օHﷱ=~X UkN 暐wwd-oJ nչgLGTe]/k^`Z4P#DMy<2g2Grx>4+fH]NTG\Tz zx;5ʫ4vY֘0ׇZ[N;2G6`|Vcw p^ep͇;7ָͦ~&'1Dz;WWyJ3-ӕgG|K{J9 *^ MIP!?=-DnWVm6>uc 0=sN֩\U_^ G@)6~Q ""QGsvl-R62\ʠH1 s360kAq,(jxDsOHH;we2qY(;cm [A|=]k@H/2W46Nr@FpcVU ȜZ똔1:JVB\ߖ-:*HtRA<`ܲeQh-g^pg=iSjж _~'FsQ #WLL4&FxQ `LqՊQl^.A4HVd|lF^v0=$w R1A}AN)yV`@:fKH.:luPm$t˖ WԹ7#^R78SUew_}l,Um"evR'*ʾ}s#x7rlE6@:8Ń:I_F7ŌE|Bgp*ns<UxXF7?y<9{L< ع}ԥ;O mܗ-qqKrΌk#ݛ8^{7eiܾ^lTzD6@g{LFpYGfߚy ,A).z oQb,DG;Q *ӑ6psJccF U=!ƋHB]ç~$Hm0Cj#mwbn1r!~7Y/FfEuI&I a ?CrTXOB@2K=yheVCl&sUwlu)6`zҐZe^'Pd۾G'$,`f ` 2عk+[r{\lZV>bwC Q D GB*}>AH7 ;1CYwnߵG~(Do'XɀndN'DG뤤$JfH:P,٥҆TE'̸~8rZG0i#pP yjNOn%#G@C]k<MlSх_an(=ҽ&" e!_!#RX`HfO<*$M s4 O~E OW56r{3UTCkR?Ȑ:4M_uqZ [beB%&@ĬBwX]5<l>&(NOuVHT‰ UL +iD@/kvE( P ƌI~dUҐ+J8'TƋ򜈯]r0U"ލnzJffpZUvTol, exȑ}Z"HE˟2N<|u$sJJ Ⱦ^w0boC)$+ruuaƂ/6$msUp$x0\`~xaGģx3B `,ՙ'D^. J/TM N+1R"*y?JvQ`HyJ:뤳C 5!1ĖӀW-M1EY >#C Џ\Z`wӫjeIhpdyqMdLmrku*?j>ﱂq7ٺ}\_\1ʉy C]ylu'ͤ {fr(Dž$ŵ= ȧ茡Pa^pmɦO佩3=Fi-n](I DйhLV7%27zLW@cEX-L-MTǺ*-L-ϊC;i＆  ޅH"ᘗYq/}EP^։ھj;4 mKEtl;M/_֫E8j.~d=`'r5=q2 ss}(XӠ@|~NHbm𕟊ˑwl5z<""w]E P" Jض00,6ىY Z1{+ۍ;+ ?J)M``HB+M=ɶ}dӏx'>HkP?&xhZP}wA&&/M³!'6#<”؄^M7ꐜJqlAaf <7KglA ~+v`3^/43^D۰rgz2x"Z&nO% SD/9L]"7e+g@,W sx)n? [dl.,f-LJfya8ՙ ұñ۴ 4t=-45͈ʦLSSoUԍdgԖEjWrG­*X.j"P~wng&{X;ƒpVmW!Txy`Li9}2Z]ÎoKK\"OB!k $v:u+ hU")cP$vv?{zoY!q]N`">bkUCؖGr9 OyE*}g?S ExE.Pre{0B&:9Jrd*=t@zIb=)eYYC7/u]mX$ѧ_A ?nq8.OGS75 9*uۀwpeb9nyr okN断=oXē!k!tI}Vy=77c!̿(ju, Ptbv"@pn ,<<+*ja2v$2 'mK=C]9Gk$dP7B_XWKa& XzwwX'Jh{RdjSMwWܕ0ސZ 񇨁'}-r`W^q@[e_G!"AG+FpaѹOFhh^#O.|H?.K/h#d(Pw΃$ s;v:D־skBb~q`<"7BS:-òCj,"#SvAv-Qj_tBQ䛮B"61ƶt%Z4i' }?&HN;S2m  ڛv Us7A=qX$%JCt`X]'[8{RV.X$];JWw|ԖX%oj3wŲtiI-zdDVflXi{kN_#IdGX5ˡoozxH<^\Ļ+m1&Qtv6Ir'Fd/ Goe:tY\6eOu~߈Lp]+a68ҎI縰z+Pu,XUb7;[Q1{caT7P `B!;uVs!ũnٌt/Z j:r.mggs扽u>ζ=jQS@9`ߢA Q^YqNu@!ϰ-ˡ^oE%Η'u9՘j6&Ftm P`DžTHD6&s}g"-,45t&=2t\BZ[S{ՙ1F{t*- 3a R>6_ٔ;i,3~(/ Ah\c㻤XԠx>gVnۢ GN8k@q]2bB^%1 eYb:$m&bk_%}Vo!ȓ%WY"snABb`w>'WMÎl=%5q$Z$k7 6ɴt(:JGy^f JO0_JQTK1f>1Yp_ᄯDLDSt [ MF稫]7ݗ +7(cM%۰;DH0ZαJ(-PȠ|4*6U4?AZW# t/hmmEJ}aS#:K^1]Ocg!ae1^rl'4MB?%_MɋB!y-_E=?N^InF;!A MYTMPv4w T56,'ab!P ۂQAUA<%|ųa${oN<4? 8@ԩ8Z߈!c!I0_'.{`buP2$uG䟯ee*CmS]"C}aS+kzC.]C$R'fre)%\iY>$vacug5`9YNn`gyuON?": ;o fB]uKZϿ&GAC.xˤ[EиJ_,WIr5(b% D@K Wwft0[O낻N3($fHԷ@ *&m RO> |̀&+Y A_ʡJwxVA=e/gX6=[4c6Tb^Ct˦gL;ijaN+uPIzzEgGdڥ!h잣BpImV?wc@o ad>5n-Hv630u;2TZz1:q􋽻_f%d%1ɣj{aH1^lW2;^$_dϗ;cӺB"G&/w c~k]~;,=/0'eqֲI}e^ٝ1lˠ:Hg2긣hyc 6oX4׾&VdZHu_SatEV\uȘƱ5p|gժ3C#a-kW.2 ak泞RxƦ0D/K{lDz rTUN|toX},7$+݀J9L/g1 JxZ!z%߰(ʃ3ҭ#h)%cRWB@#{O(S)]1XXp}i]B,Buú(]Kp-cռ^щPUT4+M!yߎ/)4Щ0*Ȕ Dz6IVA7 ٿo$p )j^R )uk~4, j+O^Gh?^H q+TEl~=дH 'K̥n(a!WHыfAH`ңȁ{2# ]>h$)j ]v[LH&M&:yܩy)>VJht%ɠ)]fԌ 6]N"a2:+@k  '9`$E?37.2! ̜ d`48NT}sP1@oIyP*YcVN֍Xuǽ ^x7$(5J>2@ (g/.TEdQA;AQ f<|vؚ yU2 CLcO}c}+%7>4ڠ,Pzj@ƱcA3&ټq&cNmni*#BM.JjPx&qnxZ.=Ldٵ֑&/}c;>Jb>Le1i?Y <~ 梁*WNL}2_aբT[49u5q߼糡9CX%rCz}|z՝橓ѐ~ɗHhP.~i Km#*uq{Bc q,)hf1#xOhk3`ػ~.hNt&UMUfmybK%iy-sU5ޜkţ$^l,p"H}0 rt7a9y!]B =$b`t4'C!o0!ܣkE0sjb(ˀv~וv^BOgɸYE%tS({B{$js>ޚ-`dJٌK%pM.ƾ%2dfrJt^]GYC}6!hudm-9*Mss0`ynsw}]BY{*}AFnf=֤>).~H=m-u#)R&n'|t#+6MUE?d!;pU-IX?釀bʽRDV0A(,v=_t×U.8(Ǚ@>Q|Xl0w01Yjfmp)_[ z,:ihDQ0BPy[! %﷊K9y+46]Sl>(VNSi."u\~o4ԿPGr ]ɍY 5u$]ݡiL8#9C񀍇`]K.'a+vK҇aPMaa&{;ҷ0bsႃU}7ɝ3BښF aՈy[ MƇe ʶЮc]2"R(D3 f@4,[&Wڈ8~Hi^p+qᄕw{DO^Ev"DEW4ybAZ;}C,?Жb vѪNNa\(RɼN g+~^& Z!#d\yj '&0Uton3Y8L+ 8k{?Z4a9yף| CR۫Z݇зę w J[BRF~`$B+;:5[w= M,eXBcFNMx`:w2}%$\2VF<!ȳLTNCzxĩzWmu'MtcC)m*ʖ]@.HXȐsPӏ6UI |'i{*^y8'|D!*8 I>dCLNK/%"uVۖu,KC %u?'T`Ư+l{b^&'1WQ9$޺SBٯ/r? o'!FeK߷[*P@V W MKk 5bl b$ayB8CD;f"m*2劬F[yY ͡|z=?ek`F?(Zi1{w&3-st#r̀w~YLfHB`Cvp緿 uQɩD(ǚ}: m]zJ&\O>}MF,u: QWTk27v.,GeCW`4T<6SY4Ș{!"@Sxa?qT|LGɤxeƣlf+'έ!"|-,kR^4AVf85<'`=0%QFDM^ɨ=yʾ"o^d Nyby@pe JK#h6|SkgjdJ:D>wEwBR4+d0f*,6m9&Ԁ+lqBflNgؽ){3_W}u"R/.`XPh6X "`zCĩx f:j&Dd6eQ&)Wy)⧙{] ~|VuQ K0Jbdl I$>CM~}`)Y:yT%cacUtoi0 ptetPƠOM>$XfemQ05µͳh`s&i3u;E) ?KـʌHcm_YfEw&ȷE 1aݼۂ޴I-}Bf<5FB1M׌7EW@y ݐh?"PWABLˎZt8{H=H*DI˯:D̞MH)΅LYWۡʑE6̄H7`Y,>ЄSfdL%vGJHCN\C֑A?: :^^A`t&q: KuՎ;][.{<8>P^_m+E Ԥc`swY8`0|Cav^kZPlͩ-Ob>wb@d0zl#bPr5dq1Sݰ6G{X6jo`(E>C!LOa`~A_;&RmISLZBK{4ِ-b,qrJo >a F$nS2N]k.1y$i {Ё\46յNc1Q;A ΗB^h&(Ef-LUx2]UC'ܹ{" {u&1SFjiu K) "X N5sB-P,T/Qe4D:ME@C;Ԑv Bؕ#:^rɛI>ʼRνDAvhk\~@ѧ<GO͞ҲJ<۲;WMSFV_ w'()J ,b {YOGPGZW_úb :+pWE^;*F.:Sjp,=!m<Y4T#e$D/ # Mv_g~h8$mD@r6 \ө'!q\YL_>lڍZH&I Mäl|X־EQCt t!@Ahhx[ /9Z)2FxPܧФTh}llt>L|S 4uUKNv׾ Q64v3ϟ &VNҵpsư.*dQ:^c%7w>٤>AP[{9v~?P5y3fVzccL6y kzȸk=E 3٢A^}}146iN W9|͡+3:E?ڊ9>-¤pX:rox9o.6¨$=q_<ݼ&ů)X p5b1'M^f:S,~cRsѓܟs 'G}jr[Krh DI tY!6|z|&|Jy'?k5FswPPq]݂|S~h \QP=e2_YH)`8 Aq?TD U%0[yD9,+ ws[ ܔїgM"%5A8ߩ4Rr=f,! pr-T5WNÕYE/ Ĺ-2~!/O>EU|4%J3DHD~كN*)H[qpel}h=iѱ |0qB!䪽."}9狘;80ځe `8!qI{w!+ঝdӔ(pAJm¯zz:NyUf,8RZi-Z6YZƉX:fbd_6O$f[roKDN#Jgn3̖Rsqtf L\K+fQ֩J:пl;3G.fKإ6fm9h;Brd)uh򤦢5f,kTs"dbl"Y⇼sB] q=8&= G~S*yHS7S̀|rՕZMG l[a])`$ڇUA$ǫ_@ap!S <8eb"Eiƻm<b 0{0KRM48_9ЄoEbg{k7r<ꮳ(gZGjD4"iڧm+yܱ}PTыN ! >/KDuSipZ)3slN!h9~i Av:~`O`%`^֐<6$[Hòj#)GDT<&ʳF5xP>9FgV3DBA:*nohn(_o94rilVKӣCŦ`8(V}A?\˩;퇯qiP:A63%"&iR6d$XXeՙKw2K'9=bvSDMKi רƉcqA$$+J, Jg#ҊnT6*6a6֌F3Z >ܕV^yp GK(cM.Yy;bClbS4(9܋VCݚ& I4,(ϙy9!}eҮF#iWP AZ0߇\y纩̵\KN1Sd y.B O(P_T}eLH~Eݴ\)AL'Oƞ~{ 7e8 ;x.\]\`Q툚V'T`LNW{D"p@ŐGU0.h(mHHUH0&nxI7B02Fqjb@*3s=IF8it,],"L[,|wS/LCς f>=I;M#7p"v ?^kք(^$Ow1B_WҌȷ λGm%Vz,!Ç? +fH=+*=췥ӓ%1 ϟ<eAʳ䵁/WAmb%\m.w|zbdۙs1> g!0f,ƌ_L 8UR ̅g=nQ6&SIǷ0m3`P"Jaȃ$޶ V3o|!XḒA!/^h׌AqRu5{z#|TN)' *#V}7+kUt 3h V*/e0Tp( y_d7ؽ ~HYCVW* 4a /<ߐy#02H8$"0r;"/|F^I-۠C6!?) Y.q&F̗jMbGmm & pf'^ҸjII$o]O(+Sۤ)I%9(%?xWB@|Z0Iшg7+[SJhFt-׊XC8+3tZmY]LD \Yj?Α)[φI[ SZuD/yEhBpI #P@6&BPǾDџG@ 6_,g²׼OKmG׬1PבUsG nQ3ڧ9N*%6F5=h\}ݥyΑLЗP-3K6\1RA9a}TEeQ]=']:vwmGO;3N(/ c'K<]zlA2EX'TtvdY-6Dd5>9O ^z{(mX`cFʜy)= KNuzGS}Hse1=nh>_{:z*6 *$G:8ڈҗ{?!sT s0gQOk7G/DfY7:pО% YQ#7M**>cRyxV:hܓ[~/B R/l~'P5ǠkB\v.1fHx!B-4ZE>XVh(DXml;z,rD'bK8^X(XJge@TjVi(s9U=f'|=u}Z@=oOE4؜ڳ|Sv.J,VeUMU5Fv?- gwctw%DTV{{jp ޑ¶9yuOEc5gUr1e %2,ïQ|ŃH([Yl$B7~Q*W̸ΐVYeyqjxš _>^l0b"n{[Ѣ#y:SLqI7f,+K'o'Wtعdeǣ"PX9u?P1Hƿ{HZꯟ&[' JP N$IP.F2SGٷnc,:f IVCjxn?yO c4k5ο\, sCDbF5"dHܣ}_uE:ÿ gE}Ϫz  QKeVtӹ/l0o"`;SdEWg"; { kH  ],1{̠ԩ9qDB|JF5v1;ַK;Wud bGsZ0OӲF YdzAtE1APO>G{UJc0h%h.*^$)D4%>2ucΚSc(BOI9#ae :fӱ24Ҿ(/Ҹ6O6 zAPqyMu2:c3+8db_Rk($uO?{+ Y1==Y854{W:zH2z[ z8թ7k,X0i^BVƮ B}lv2ū{Rf++ٸQ?O\Zx V1@=\]!y*kibETzeL q0藣Xg ,Qz+gȮ O "E#V/(K"E.6INu$׎gs|m+5w^[-K,4+ѷ_RxP n)84Q#PXyEt(1)ٕ.Hօ#3FX%lHL62 ۃAIO5=$b\6>,r;q:UŎѶJ>gu6ϑO5LBF2)]CϬjf|f|t;EF_׹!b7<2/ʆ~J R ÈֲPzaS2]ѻ{VEhG:=s#x@v=߆L dr9Ys0Ϛ.:$z(tWdwA֞д飥]j/[Vݗppzu{WΑ`{\~W˖` Pf!޸3fbT.{c74Fl|I9ZRf $)#I |*w )HE/ڳmqݭAEo̥1uiE(EݴL t5tR>FXH]亟ӓ8  dK?-mhǷ># 6%hC*<L! jf'.4Wvx ,_y`#3jdS?, lOȩM{f5)iGj|϶E9hv䨯߿eysFy `Pqj{ ,Xf IqTlL? >zL|jrGaO+!䥏81gD>ǟe) Vї O^Rf88g%ۋx̧K VqYu[ƧPf6.{'T)"k''{_s p k5V6'ɨA?jfz۷vqk&aw!q^8qV:ԃ7ZU"'X`"luIk(i6a$Ye#l"횳L h^и|%U;,hou3 CM>c:6 בV#D(28*wkDk9qs4ChlH2qa.,p'm0E1y_^8̚[3:7ֳc@:%5߃9{m6, ^q@>羊I<'#**zF;LvS>7Y6: XX""$·0''ӕkam1JHpNS84[H"-cOkh u〦~}< Fv躕zFhG5hdrRJ,!ѧ3_%L+(8Vk}ݜ DyVP%q<Mu>vˢ+ -Fds9Ìրѧ=/$&z:Ǎ3&scQ6a̓NO7`T}Wޕ#Ȝ] ໷Q U93?t[CRHGsSu3EDو))'8 &BGV>߱W`Qv3Ө/ƤR3̑oii!1B`\X'w݊"~{`=O\?/yJ׉&~gsotj}X{u\tD+UGQb.zK=ߠ*n N5|XHp{5e;Hʿgk(hR_UwQxTf7jD~`%\ZQ׮b;B|WB8l+5`L#y n j:X]ubSE3Rk;b䣉u3^ 䶳srߎ:({ܡE D#(=6V;˥nWP4|z{rmXe@|UG䵹c1>Ub!dνAWbm9jת' ֊+s/:2Kj0\V2h:6D/+VB} mCÛOy7[,u92neE$K _zc?}ǮPnAjK7Y%3WJBgnr@G3͙cEǝRY%>cV} x.H=$ks< >x܈P+<1f Rwoty-%x/ o'z%Fx($ m2$f~pe7gՋ\A g*l#݋|b+ wCؑP2?C]n7Z!s0Wc9W[\ nn|C8TUΓOqmm[M[E&:L@/޿rT1慞4tUa+66<^ɻ6>v({3w~~P(PeӲߢ#GROK;Xp{s`5wSɎyȷv})̇n#ₒ4:7C܊E_H#O2+ήcĻ3AU[3 43>'ɖuKfW\bCJSbRN2ɏyCTIMmt6ĴD;Wc*\+ىS^ߺZFp=mX6U˰WaAvuܒ)bXڟGˤ{Uod{//7U%\'ipdcMe`ξul,جqN $gtF m%8 Eo88΍3Z?2zTtaڜ*1 }q Z)pV)QN^ B$ Խ m)0×( %+4"^v!~7X]R㵐 'U v>/ |(]oƦJO%fp0.8xve|1dϵF;* D)\ OK(:{vD:4L(kt_\Bbg\߀w!#O X2gPDq@xd[/J7De$y^OM}ΩqpKt"NڏyHJ_ ]];>m1;+M|ěd1߾ tNC eRu.⏋1boɦZ)Tҏ{A9V͝n7+C"na'8L U/Y@829|y}MA%rujTDD?4ez)N#Ct fF[mdyy8ã uUD@|(6P}X |4tou%8y;Jdh靇GAz#bjJс#r,X=DC=7VFTY@&TtAR9-%) nz!`6V#6Ib9:C3oDN4Ea%M ͍2"$}-Dub!TIogd0_Ԝ8W" ʹyAr%ny&wSZ_âtHSΒ{6Lչ51:B k?̉vX"lnH4w}3%1hn)c RWЌ 2<{ <U/aey qt<Z鳡J1W@5Qm ~q_{zuxȎ%FN{ deˋ5EW)H䥛_H+[ Fi9d12#]AFuR{o\ u[ a[h-ǥ4 m!jo\Tb1̩;SedhB,oCc\ySwN^곾8S]IU'@c`j |_fZ߰|B|pl94YJj]cw#XH&|+BPLӮU F{< ~f( *ۚN)yн$cp"ͩ#?@9H;D/}RL$YeLߊEV3zQ؝[lR'.9(OluK`[\깿$?6.tr~6}uWn/OAbUd.aO zh,,#/&/m+!<{2;FA+=Fd"y&UMkUx}_B0m*,k]0#6-F4ޒ[{f^x#xm3@?P.Нk)]=%nUZK=J]H=M+n}ym-}4 I?_'ӔC+i^ڊeYߟdbؗV"mKS!b;VL"Є@n^/ebGs5m=lP5e&h'{]Ýdк4sJsޟ%Vì4$s_30W"x,̆2v5ނUT ci*oΡn=T3O=N>XmZdՆ"W"IFC$bG58[3ijg|M~~aYh-w-14:-#ӓ"$M݄sc>Bd "H>Fjs; 3w1>7mFxkdշqΈغU x6"+,v`;Y {3 .6{E LF+}qGݍ"b"L]u3r ǟIa4'?з44/7"[A'V5D0V- Xi2>|=Lj7/ ?zݸ!4í]O1>9j}zJf>uv 3j|I%u!yX+oHFVV)=dd+kcDK:(ړ+["ʬ3YvQe>p!T .OyPĿT8/<YJf3}=X5WY߅7'Lj]v.znbGQBM[܈ShwTDN&lE]~҃_&2;׮,Din/ϳJRݖEA"i]] }Sa0*j*$rz2٢GH1Zk++y^MV5klb!Ȩ5\V\QS-c[ZB9t!"tvN I*|cs;<&܃/ 2pJv3Kx͌5$u'464yL2nQ%/K>eCig:`ѿJ0/h9t J5\ aHgHӕܝr %HIﮜ2ġk%h\utm߂'jv}1oa?ba̜xl]|?PX$~v1iʃH#^XoHoaJ&wDK:-Φ>]n~hDf -5=މ@ 틷#Zn@ t&e^dRHMuD7 P+l_’42 p?/K"$O{ul"}Bzܗ1NxIA"&)@ϰ r $ND2^ȹt|%nI||WlRF?5{v{a{Dw 7,Ay?ACaBЖ=k1^]@)/i[QN+=AqM}UL`xph=)5'瑷~F$JBQc1|r x!5K'&UqE MզH}N[x=6@HKTxzG&PZf6 (prH9me>|Z&h kmsaJC3+ײ5!s{% _?c)߀y_>CЪ?}\&3YTZ d &A҅`KW҉2J{i)䕽wu;4JEy"]ӼbރCHtĤR}Dwj CmeЍ&3s-"6.G9-J@ A-9fV4'7rM&wO|I0 YZfPortfolio/data/LPP2005.rda0000644000175100001440000005167413630677273015011 0ustar hornikusers7zXZi"6!Xy1S])TW"nRʟoÞu{BUM{g {l1PhDC^QQOkE_^=? %4f0Bpְ  ӑ`t3sm?ớ#3 ze };K`IП(3;u&&;ʷN]zd=HK_4n / -s7Yeϐ4 \Qwী1H4,µy3Ęu7zϳϭ^Dd6N?U] d?yi&%'m׬%M\quh/J¬LC~yExj;В /8W7附O}JGu-AnG%e[n=gjWtFwA|>RCⷘEFvmնa6L⒛ ԩ쎆ygha"8w,W"!XGNC.8JC?<SN/cN~(&._?t(Fh/=g؂iuz0uTPb(CsNԊBx ln.=E!kwۗ|vi,U^s"&MYDj}h"ٌĥn=s O3_Jl <'u]3^ē%fX{E yݲKdGZ5f`)-,A%4舓w0S N3|&!}ӬIjx }tn=:[ģ]_ر,9c}tqh:U_A_ I.汉tG[#*iSL< vqD Ĵ 5;%RL: !aWMbel0tE#J` ^'YLkiD5Ŀ."э҄ʕȭYs#))xfgf榴9eJnvl,Z3܌Hx矖[EL 1`׺)wǕV )v=l\(/yXSOqOgtZ /wsG5 CM(?Ų95!4 h=1)I^0 s-a$m }D%a^OWrr'{oPp\@pW2 ͺ|9Ѳ]K 3Š)jg^ecIo>pAkEa.z͆yy_ۉ]Cay(CNE|rqĦn5' R6f W182>P GB+#ԽW.75?!.2g;P9D|Uƹ+7CM Jh]vj_ya 7yѭPK`ƴ8)cǯ~.;\?f#O|E1jv1tftIW Y 0K܈;sxZK)gdQq5†TÙ\f?]\f\*oG8sXzJsWCBQƨ-l be~wcU]!` ^ě(nn4}Mp?c ')ċ Y,VKi3l'c#Tzkp6g $gD(m 8"PBbFZ1jAMgC$8 ډe_V? Ƕ)E1U/kҋLZL=\[#")"Ѿ>,e}smN|;j9V~~_6S5S>-h4h >+gBVROUA\.k^0s|@PwMuxûP;h\W=as7A{4/gueMWNZ=NC޳F5uxỴmX5%>|Vcq5 {⸻[Lh|?QwR0c㞶%j_%;`rG|13Nq%щJ!tPĘ ;~Iz {)t3Rۉ8U:c{0`(1m 6X,2(~0 tVoZ_3(Ug_82b+CՔH*_B|{f:FO:T+;k銣P`%ܜ D2O˅yW Í^H0]V)&zS%d8[kuP>Il ʲ.O1m慧$葷IelXZMVq\N 5*?R0:ThJW͘$bU)R!ʓ̇d+eؽ#s孶4 M=W]&\aZ3|sA_h$ӡn7[?נRY@/mw7>oKKQKO /ltaHp~b4M\jD9ڙL250n= /(ozG~&f?}oԬm^{`ʇU )>yjarZXaс\nIMXm60ʧV=9۱*PoNׄ`SoD-Y|jʃ1MH:kBV焟6eǴ{\B^D7^Wpk!WDg $8-2\ÌZA@_7"\p_Ahh.0u\'ou T%VG /FaI/=fO:G`m)'OOrWlcNZ/ Щw QK; 5 ]@,@ S0v ?P˞0.0ԩZ,qphIMc\ 3$4Cb#J{x@2"=Vi) /}ߐG"-Wl$TwKꨱ94] oȅ0\k1nXk2/S4j*[_!>DЗY]@E \sBR& ^ PrS;xW6NL=É>8O`ν]Y*}8Š6!5߿qJw͖^Cʜ3g@ 6c5ݵ$]o"PM|k'p&3, jPr!KSP2 V\UgPbPXW؎^RkHpYn?̻{#fgQcSMA}|7( [4RZ)Rt8a(|!S*46)\RSIOFR:orb9r}-"ۿ'20CyQolLi^fOlLJ=y+9'm-{Ю lA+ĶPT'wF*8%>ULs9 kzfa˞NtL4JADp _~tzt.\=D8 X{m<͸ /ιPHdKƍyC֮Lbh.SGvh{=ɐ,F-@dnWñIO㲳#U4ƊUZ@7 q^txX6'L9 2B?I# 1COmDxFVhäo~T"(oJD*םlBLjbҦ2b6Iq>CM}Y\GM+417vO=< ~Ew~m:o, (p[V/;@0z93}5FIRJD9WwCt11j6xXDLUn.}3iu{c%^Ŝ/h HMs8S߮zZ?ˑ{%GL0j?U1Si,X5(V+E>2m?\"UC S#[6qqgP w Aށ,bĺ!|%gMa/> -3OS$|r|'7|ެsd١@!nۊuQ&%%WO3v6|XE۱8YZTEG݂I.Up?BVkKl ro|'j?iY:IsrF)IdP@@ qD!*2S _ +#EyedYLYz~MD)byэrnImZ]p}G>9hL:X$ u!9mg *mkt!cJ٠YȋKަEky7F۷Qck\cOGeMrwmA@vʽaEi~u-*ϙ8:zom062UΤzܟd'@GSv?{jꢐhc* % y?2 (q iMIFqaS"S ;aÅ3b}U[2' xr3su\ 55೼2Jc`lÐh; (ѕȐt⒝. 5ƾ\Jn*#&ýtJb-sLȥ+pD,bg<HpsփJi`_b ~;18ihdhT.Vb{|L ] 3ڂlϟ67 2l [F*.`:&, Y[ċ`k2iDI6Ejݤ3LwDBw i3ڡ&E@puwwJjkdTI4,+w_'@?opwu"͂-ᩡBmebO%{G6+9;K0*{i]Xl+a`HૉsW(#&[T<iZE` )<.i72Amj ݒ4uo%` ";v?(\Jdw6; +8>h=UO'?MHMib'>ihU,o)lsxcBH2.t3=tܿЍpDxDpJ?qCrv;yCEkۆD''),LF$3H5DI;SGcރV"fpTCè+䮏> ]YS|J tZ~Xy:bt+9R@ofܴylx;D!*3BxjbJ5YzR~Πy3iYCDy%s7d׎y%80u!lڵb=ｿ JR1 <"˰eюjKHvO;Ȋ#a[ۢIj3;TgrïP Rv&$\?7LCbQDa]򾟎IXv9gӲK#p\7ᑅ7QVlAw{AHˬ`O2>_!t-VAV;+ݥ!ou6B'V*5bt'r%ъ`zKW_QU8֎;42;PZ \>x^(VQ҅ hqE@ 5Ӗ٥{78VP#*Jw&Jj)gwj${v h!{V9An+y-$E%unoyWN\X"@&݊- V(c1"4&0u]Ƌ^,)2ty5/!m_SIAhn?mHTuTkFH0\Bl `5.{rʢBE\/BTxbk_^Ex-$e'q!&UѼ)6xf";QM+]Vπˉ b AnATZ)=tP2p/H>an ^Zh1kk-`|~p񱽓k%^DqI|/BU:޶yfw-LQffY=ZR<`r(6S3GVoo9%b{)/y s Bgroك`29Ѻa{ آ=zKJaC| W6WKC˖'Zb~럳bE>[N![p޼<`3G("h4(`O ;cIS KLV-ݻ\̋D.B\BQ8q_P}K&Cp3t2r4"l1h!rx.}ʽW- ( dK5e!JFU+>I><7n?1XK09(`?4[ot4QU 䜒g,]]ժBA4 ? ÚU3ˁmO`/ΙUK/#ȩ"qc@joqfxAԜsgإr0y@Ah^MMע9(ҷAy(fR$ݒsPVe۲@=7L]n{^ˆ4oHOǟ 8pVLf§jj7{amy=n \–lFc0vn[Y*48ղ?>Μ6NB DB I%sȡ>KYܦ̹_dF6UgNF!ؖ;ŴbKmh)DOUkU);,oInz\( c>2tf]Jx\FYKHz?7!&QBǔwDD"*I6q*o94ˏTSUvrDXLpMd'pwR%E&͇'LA<|A|DQzT~FأlYH[x l8~q\ٝ8ȶd2q-A*]m\q7v[(k MQ,rwB,k)*b~@!,\"~|9Kk%W@}]Nj'g4iZEo`ڙs_.h|2 l-3hfWyE87Ǽim,< iF5d $h:K{ 1-8 It mʎ] 9d$a8/RY^nq()Ѿ>~LJw;$>{`^a&.wP BEd_sL*85=yd)cV oK,yLc)rYC?Y%QA8VBiz_YARXa`Zis:)m`#Yb敢o',6;@rz}FqCA1Fz BQ}ɓOC K%.5MYh3 "grdZ0O*3\묎}i}Q%Xڦ7po{1w-bHP4yh9逄ے1b'mjRi , '!ӨӴ?g,P)HC϶bp ȳ7^*`' 꿕{l}1J[ߩMTzQ74:zQh:y+C#4H sU 's2KN!nP/}cwQsv[H'axpVt)P[8nXΆ!,p{Iw re,s/ڗCY&/y[ 3Gڵ4.j)gcT)~ Y}A}j~Bl癋huZl2cWjqw3_ד}!0r䫾{g$'n_(1B=rJsU6C>h+O9NN࠳rEk>cU[g_kGvm\{l=k ^JLR6(Mi19A B/\+#2qzIŊ5u s1Z`(d =8u>A8g'yurSK%k^Gq b*ahe"io"᪵%YE3̨D` uN%!aC+hk~c"Vx;#5?# 'h .IEqQ&<.㚍XjEj1EH 7pYWrvz,(n` %pz;|"."v}IHpc^'+8 |?omِbatIVύw;aYְ.ѵ ёTx##Ťī[1hCu!*d)MijoB[H~"nC9"U<MBa8#[mO)BDÐq e+`ɶ0G! &wFL=W sqwZ"G;&?7Q^Woȑ'd@=N΢ڨ(MKn.C*IEQ}V!d&;d13ӊ-3<Mͣp6VbwT$p?\Y"j! VRrʎ g(}^Do&Q@fPqM pGyC0R%r Gi.Հ|- J__FӨCg&Ɇ d5\0T\&R9bv),_rM{1H|[ݶ/t]yYfG/(MmoQxa*fE} Қ|/Y;(P4*o 0< ^4z_ =۪0 .6|-U;cWn (|=ذE9:|G 3 腽5ǟYiTbP\iJ&27jrqvb:K G:Iv+ʶZ3ɶGsT4?7XDeAV h qxQLͭb)a+hy*3 ;zYNŇ/kLQ.v. Bl *op%;ց*m_QHWϋOo6 Efr~GC !\6͙QsQe)8}dˀg^dQ;g^t.7|deb w)t_ly+ (tXf_/(=(H~i.%ڽbҩ<ٛfVEDeQQrϤ8)tC*MH#Dž/PÔaߑb By͌@^ $mu vk۩ ţj/P\-á sV~^|SEYF:+ &wZ]` vtoL PU0ޢXTHeXʩ薕YHQH%h, Hg I웺`ttȔQ]39ՁZiedE/fA[,S|FξC#Ɯqy6 H}ɣ. Ndvj_"h7A`m B$T|oİ7.nWXH^Lw؎CroBrhĔq}Zjab<_zUσ<dܥbT/g|A +K¢Ya^?()ֱ=_;`tEF٬L;Slr-.H/z]5"꟒wQk|ALB_&MG51SNvɎVKRQ3j4-NIGX"PtijT9Uk>'mM oV](xR"FdA z̉FǕ$k5fڑKhr\9cC=~" i/pԢT10|$p<2ņ-`&҉+?p7*Kܓ ųFNe9WKrC.p$t_W8z[UڣHW/# ̆ ߠCaKsv_JMkA2!cu7sVfH ;dͥv@Qn-V l0?b=u j4;Wv~6 5֫ihZ%wV=Hۄ 3M}X`l6'LMq7& FoE{8z7 \*,̝a9^x13%S+-oܕɫBMSm-^>W.e&qIUKDO6۵ZW9Qg?ŔMS C݉u:ZBؓ+i+_8ol ? rϨkN>xxo ?BJFM|Q&1gI"P7@f˞LNFk zq2xJUu 9Ke5>=jHb(Z<{MyFp~RC1,u+fq)P/S<;@JPF>k7EHX h߷2u>%{t @cݒģhKjb@GC'|-XRa]O'Q>Edjp8t@CBwTgBwigr5!E:>y*0KVDT~,*~c{[u%v,c[,r,& 2O ?x hF""]e2B@8WǍ(L7g7G|d*65/vK߈0Ļ/[SqN [-9s1 {Xf1ƻT;0:V$ܽ^p`XfT0kP'#E]dJ*Pjae XX݆!JUΥ ;wj-r>oYݠ, [~Vc3"(C%#1֍mr]˩X$jip!~GХ;t0d%` K+j~Xp g@ͱ׶2W@[\cZi:㚕o`:6[g~Tw T PG;UEIy&J94JL K9ϝ̭M`$v?X҄v?)ǷH<9 :IaDY;ɠq8" 2[B~cje؎G)ړ'pNs~3aֿMsmD)nZBgw@a* .i ?Es>JVK9E{v8 *) :%Ү&eHgeF1Q(rjmp6s:R&X,-p'\*% i*3HȔq):ͲdA7\ob,$̜f^?rw<*V9!q1ՃC')NSɇn r$1ngr;2n&|8Sav)MA#kBf\pLCyj &Pȹ̎Φ<Byi(q<_(^]vDgvR)Ts[q`Y ix]d\f|2;N35K㐪M!&0'-uÝ3o:Ƿ+0@~yWϠ#) PUG189&I"Z!{uU!y!^>T粎)!=:Nc~ّ!(PxF|Ie*vƑ@F7p wnY?&)que̓ec)%o~@V9Jo)g8]g}Vdݻf~Kp]|_^sICtzIqguFhAHCGO a^ң*\s@۔W}y^Yȩ=,Op7 Gqm"CV'}&'BM&ї.4r(ofrt"2.ŋtE)R^es?hy*PK<0c*>Yqo،ԗx(F=J\񱦁-@rAx'^Y/Sg]?g)g,GfDw`1^yR%^E0(dxD–ٲQ­0xLi].=bwQJxB{OH\%x[Q {H [:|Of&/'hQjl6?Y]J3{{?6+wO7.бS15TTnY{M' ۜq=/o#Ѡ޵;sn#XY`I5y9C]4r$ѧT[is[k8X\w0pi|7LI_&'S (TP^4:] bx_ﱡg_\MDȻ H1*X]yzBR. #sIW t=e$EқxK84=9WJLwB;#>2x>cȱMZ%xusO~\/]ԸdFYD0̈)i>fIcOG;iS)*{ V8]񷛛j.^Q e'BMs6{Sw퓦=t)̀Z!!uA Uv5EbdVdHL?^@*d@&Qjѵj b(rlNq6XlG.uOSn~Aɫ+BV,B9GqC_3>)3 yZZ\9t_mݴ`PnIu͐&E@kh (4ZZ yXEmV'e8_{3 ;XЬ\>M_UuSsj*=͌hJ\XQdb\[юnX&|ױ!)|LUi@~DzG}㐤ۻ3iR+lgzce SzIQ!Bis.p؈=GYGEm gՔ<;)Ck_ $f(gLoA vg]6 ?W(ݓ$%0fLҍ~>m]4p6PfL!rd6dbы%=sQ\>{ݙɼ+tg5=m2c}/~V,ǚp]2pRSf[܀(*1O.>0 YZfPortfolio/data/LPP2005.RET.rda0000644000175100001440000006541313630677273015436 0ustar hornikusersuXU|"bѥt砻[R@PAk( RR/s9ug]kk4  vr2ȶ"%FB5ҚXXHKJʉ[ڐ3k+˨!+;EG]1(sJ(&X6=X?{O&";OKQp5{ zFWgG MtZQMA/#ڌa+:%dC n^t$2 ֕M 95>j>7FNЫfYFM~ʞ"3?B.uki:۬j&qnd!*p[ kKes^GK ^UYpwV|#5&+Zo~/^鐐=lDj/فq]*ڥ!hu=P!-;'^bd~ߋt Veq6(<\VO[/ UCމ<j۲:6AR?T'?*oˈ)ꤣ>hHvN<`_*%th__om^c`/ӍE?#{\`y(`a lycE:^՝ ܖ#KṲ_1k=Dteq]sY?X{ ]j#Z8euաE=`"23=/yWi%;ݙ?#<9^wѦǽp9 dY%% A;vYhzqT/uڰ&d/ Bp^g}>B*3v bu W?1qɶ%[t_&˭@_TFUl\huyg},ul(b#Go*;D0Tt,<v+?ÄC/phj>: fODl//ʜy[`=ril$m!^rPab$^ؚ @)Lh d?^k5M= qgqcu 0 (^,ol Ӭ2R3} &EUn#K1Ԍ,>- #Dk̔<fo'Gofˏ d1Dxů6KQB ݼ K4?{t 9xʝ:\S&npyfth4E铟vW7w*h.EBYwܹhzZc$x(Ӭ|7G_U^+utjAU!=׭aSO`k 9t5s)E%ё~-ʖkO#iN~Zg;SsM:_ISn^e9e?3D/T69k(U-s# tB8?@o`閜xL$Z;\ݥ٣AfNh@4 4,^K{ݶX^"24k8Jo`8 ]:;ج"`'y~=-/56ڽ FAgsjN3N\Cq~πsN?@a .P`e@p9*Kqr.! 2׍/"ϺqUyuZ/`܆'*|en?*`LGF}"ơ p8Q#hCQ.}mMQ-w,;wMrbf::79k|9.ѝge1Ə/ KlmU3ĘN4w?ov~A׫'Ozb"y,K5lO#9C?<<6ĞkFLg%@3˘5\hx{IzІ:9ggz :)㨰D}QAxvJCZYdr']Y8)|T- [|a4Sy^3 ,vIƁoHѥ%ehviulG1bޟ IaGUEk4PjKOݢ&$]yXI pԠ!)+?83VL <'^h7$m3@W!N8O f "sV~&D86wf*&15بq͛sGeay=x^砃PŧڊgNW>>ybTWma Fn*2St!JY]봇&74h ̌AxV{j촮W+^)[1 j$bj>۽KLf*CoA/SOg}EumSv^#ku# U%oHTȡWϲ7[} M ;cYCIQW} /9H?uh,ԝ=o;&Q =S~$ bXgjga;G-ƥj{d_FOǺ@N:o!C}Ƀ,`$p#9H@SoݷB mU_Ĝ)'}8?&=MhXK6AKJf+h1g{><\y:6hv۫Pc~ο!2P]$0$1-Ϋ,YA%C ELxҹoTfwI@C 74N(i/fȁ˽ڨAPHSb ANJg/QOAKzPkQ套, w@dsF Fi)JӲ|ObȯSnpSl8^;r`fW:NY> !%&:&ɄJ(| hv;>!Q]k5obq~V#`_ܽY٤$`ؓ>'h:v=7r)|<%)ȸ"CvZBзzwco~0sip +'H(]Oݩ83ʎR4VX?n(ٜX^$FNH9}gU?js9ߥIV>3p0&n uywϢAb7Xs <>6#_K|fu53dŔ.l& 3wX8tkP|:*Lw2ןstu1 =<8Xە?g e8]v,x2 bU2U7dDH?n5K8<\D2‚40vt.8~ h)Bw>?6qzM{l!* A*;q:9V(c^mF{XaA k;Fgr򘏴cj'.p^ A^< $G{f?Dmf]= 1k h}ju }KSd߭}‘Wy\sr@>mcTA=ѮXǪbR.pCW3czG&p 1 =eGam~<Š,Mr6Ġb %eSˣ?*/P8l0l:9=|kvӜd? pQkB3)>jS$с1ه;qoY}CUj.Hupy'3%/U|z\,^/THס{<_Ǹ 3trȢ wAf|˝jz@ C E{oOo<( EƾͲ͓bobTd^+Ԑ$}38|v`&YFKIo?8?彡YHjpXW?i5Gܯn)|s@*d<\ :6\!9Q/$/Řz׬O}+2zmUh@9gNG'K/ UF7-1ΏjI2jEblӮ.8/wz +^ҷhu"CHՌ$܃7 &~(H3QwPgHhi+CO =}ݦEonHU_orr׬윐AT Q_M Q/[+o|ɸ/h!17 ~:{!$\# yo?SNLOCch{2֓&mIEIu<_'I'vtW9  9lˆ&*,X8ʘ, M]C#uNK˕ tl>Vf+@ܩzpL0a,]Co9GloXb yKq_* .=&U6%&F=.?LCsWN۱ouB5ܺ) w.ΣLsK=='0e?4Bsh)u|Fc*֭?O_FZW7z8q o )_<ۛ:t~ $r69L"ZĘ2c`>K=}^8-u  _ap8[=Iʤysud!W9jծ]ïwЦ/}{m_3.OF=ph[~ƋE7TI4":!0?? }RuĨ ~ s/RYY~8l9|ö]));/HOTs uY{Sωށ;u\c7NnGĨ2iI4n4*KA qb"M ښTo_@Zg2Hܛ~T;tV(2EZL{_4G:71dpR\:,]QjN*|(#ݣuEo3Ao]V_&}%W.0xFINp",hk[Cиq[38]³{zJD9F=4Q:{]Ln[ad}]%N>e I%be_ۗ*7) ꢨ\^1!p5MyҴuueIx7_o>9w*ѡ oםO2| %zM.Y;,g6 pbjOd; >@X^ypF_5{w`ROֺX+fSR& $[~c qk/N˶t4!sfMv$3爢91T_`͗5>hS ueʕB? `7>.`.$ɬxVnܺV `i?<4r w3 B)_4lQ )⊍3,8EYN@og4-dփ᱁ fjdN?*ϗ{ C$!E! CI>s.o9X.־Zw-2zi ػW!]r԰胕FeO9Nz;+e#FsJ L@9sh%*:D 9U1hݰ~'f%4gIݰ: = ܡ=6{W W܎:Qet?98jz>G4vm; & %PETZWYCga U'YbAyHDf ?x~A?ipW!4gͭ$zK&4gy'^[ .]5~]uߘ1Mo߱ 67X&S=`zlMPoۮr+F|]AUӓƢ\yR<:֩Ț@T;2"h3)C/#TNhPw)NpII+ϐݘ`c^ܼ"|Qd2}1w~ dzwNP t!gvj-/:η?-X]z .uh+;WUT\b5ԊrVR>-~tBWGO;jYBLε2(S!:g^3&Vd,)x鳼:`(y%N2XiE -tr+O 5HtѤkp^z,E6nWuȭپu^4UT]o !E-@řń~:D3$F@`qK.eh|̵!-++|e3IxpợpP|y8^1:O)~\\9Ipgr<xCih[kdi U,'EePt` !_;sWѪ(Ci̾ffAZg#?H"bD~/UV2TT`}Ƌ3@c@ h=Y}$ܾUx$ l9_& _zVݲf%B~\V|r:o%">^oH-|m_"S^D őGr:ɋ$x J}nÕJ>4p ΦC yG{go5~HABçq)m>8ъt>Gh$cp˿w<~Q nڧ-FcOK4D 9c$!#]=-}s{Qh=A%qaE{ r[s DaFJ2E=)K;~ycܧѻ6ѿh@l kfpȝMُ_=VE s-Vu\|6_nC9Kw8H%!zy+2c.U}qhhE] *1d]ЫzHH,wXtd0pYskƟԌ5iqBg 5WGLP &Z^iü.>U{) ԵAkZ@Hv{@܎fg0&oa̮6Ѫpv.k 0vXwƕ6X ;_2O+stЦDr~=hF{}v7y/!ǔ͎gt2AƷO qsPL1j:UEG߼Œqf1j/qS l5v27A^lOLbXV35! i}J1l><ȩpE><;mŌf_!OFs=[~;R{W/^MCmdX֖!d%>Bos__ƬsQA!Z ۡ;;6Bj2elAȫoB9F o*d^6WH-ۅ7$ 4 qS.IpR!M#1}GJ'hBE]~`\g:Cp(Ȯq x~yϭK/@ɗ2,xvh8$\+ ̈Sr)7Z;@k(#w蔻wO.D}|kPq]!3|*)W )AU4 iV~5L&P?^Xz~w坂HsWV/Kt=jzj;Pbߞ !W=J喾~d)2/<[> LI++d,b͋MMvb~bn;3ۯC!ڤD CuCmA'RCF ^M&xV5%8=|E|ү֏v) A |]ڻo o\n^t5 22Xe) y3_R6ߪ_r~`nc}n/Uq(Y=uꭧD;csxYݎ)x=}7(!B!i;p2' X3ѮmcuF#xAvHh I?BgX4T×ĥ\ۍQ z UA4e0EVw-FZp1{PeM+T'0ci_F!#:܂;$7‹'>?3}!"[%u[ENvɋ;?QGz_m~7߄_z 끕Kw`腷3^V!gIZE9Y3"%yc%Im{03,PwQA6ˑQ2|P<س c~Gb2P[wi?d$@G)x2dg Q tWH+uhF1( 4@Pm7\NfׄxF KKc':%)KНOꍅ=!Ta#C^7.|:1k?z(=tHf*/Dg)rwg+ 5)d%ŋCv'~@s}J$:|/Dj=pr|!E 1*w9Зy;W xq 2Cr̼!1$5b~TI96lZ~^l|CN-JʓYxNqT~|oG^lKV~faUÐ}R[[dDxr [}~߫k.npW+No([r 0`]y2Чf6_F+a#Ϡl%<[}zFX,P\9AKI3}_d +X>@z Ŋ(`²MPzMZ.H`uGGL!d& cUC1C]G> _y$n~;VXɭ j߀ w2Rۉ$$Ei.JYu>k_U/F4їaqZu,J_Kts.X ю!rex;NoR睱 \Wl ה)u=ɋ?=OMo@&^AK{<_) _!tt0 Q|>99w+晧Y~+#r6 7de6x:> E?z#P5OK]NtpܘUۼQ#|!d-^?aF7ٳŢy?[u*;7 mj[D$G(BD9 `(7K%?РǎlbMwB\\oi?=t=r7D.\=m֏ƩoaJgdئnuQ|;i\KGݞt^zJ_q;NzF Tۼň~?1tɀ6j*[˱=@yJӭԒ9]iХQ GFѧkzf we"^궔혥jݒ91Z>ܔi}QAY- S* Y+6_ȁ{ ;M99S2?BFٍ!v`ꒈ0\ZK]ѧWpy}dkl֗1:]ؐzFGa7UHeLmF҅NgűdK}8j߰ri@Up}_ 6+0Fc0YaKzڵxG+]iP)F-}+= 9WԘ~ϝfsr-[ n^l)%ڗx/Fzէhkɔ$FAJ g :\Tc("N`ڡ_"ٱH?twWnc0~hc bGO4 Yn!Ǒk,\WZF\kԿH+a˯k, wn Uѥmm 8,4`]sctF6~Tl bq!|S ']3 Q/B'P]o{se` 2J #-s_I'^@Fpؤ?&x]Ѿ2)*⺴CZA@3y8)٧ܾA7X8>` koG\< 'Rva yګYG"|z"K%\zQs_p3cj )ѾH-ڴ0[vźN#fje*AMO7i%#bg,m1DeU7ۭ9xC/oW{>ISy2ze9"n|]levCd E35ڝ~ʯࣆѺ [9I)WW,wOŶp*渼~R~E =8S}I}gssMC։ 3 &ߤ Y[V ,EzDCκ_^UԂ7;ɰ lrQ|wHG@4l j>0?O= &y4<,!EgY#1G߸zH%JT·G4sjv{,}5W.Xؐl;N%Ӽ%Z?n͝D2צJ{ЯӏS ~ (k :N}΂袶Mp xwaI=$.7zx)C+6tI?}ZM<]ڳs/_m j)F_R]Ax6 ,ڭeo6EK ^%C~֝oO_f?0FP=h>zx-x??^ҷ} :+!퍈O1󡨊LnG 9c9eV{Ȫt₄~I8H,jوc7~\Sc.yQA[7"]s;B&F>)-ky+qA Uo@ୣߝuaXZn>t\5\[OLա{܌~?8(~DJ*Sy`];w NobY>fGyzXԝYT "}DHMp;~n}|㖽$h >Tj͞Zes!0O=< >/5>Ts{A'>B9m [ |:+A6)}=LnZɓwA&U:??`BlOc1eҀ;Gb_D\͏ױ9ܪߵK ~R|/Ծ,6˯.?klpmq\(O-;у=\>`n\EtE\ r3yBe=Z @#TxqnX˘3r)+er _Xl9nnwbGp _`d4-0V{c`InF0 x4'Om?7MUzT3.Ɓߐ^2|X B'+&?LS(RHkr`mc+h;hYjO/GUɗ&>6=NU;g~lae[%{"Izp &l'85|~$CAюG?#bF#kݤ*Aifr+`I}f(2b~n;h7Rx/ݴlH.ULT^QE5#i`Q* }yL)mc_1GhC؛ܲ7hI%K~.A ח#`A@ɵg+~&;5 G/jӃF1qt/9CNj&I c0TQ~c'g?r 2q^ØV>q(9= "7;;AS(55j?DWA.~IiveEOJ!a7#`i0{{@O i9بVqE޿Ձ!f2|~*M\J?4"GvIS>QtK~NG#єޚCg9w-y ͙Dta-`9C-[`Nu+[8^ÂϠJQY= ?.rfjs`=B*)5u"[F >WOK{兙(~[}R~<Z ީꣶ "tyq{䔶~-][]B0:ygξ_{e0Ny hկ7}6,4HJz`k^?('ٶ\|%r3>:xsۤ͆S3%h|عI^/σS]Umȳ ?xnO .FϘRMR5nE`%r&dq@pF7%. =ktH _% zOF@y:;Aߑ2m^]jͯH@W/ mpuB~-]-0&}Xܜ'?𛠻@rϻd'qGpP %iESZ+sߙ ΍?:] (oʀ◵ծח HunD"NJ<T[DByRǎͤϧJPco)Kg?9֙/ֶ _pZ 6wHY[=*-7@y4]fO'٧` 4ۿebP ReCKcJAE+/'a 9Ñ>Cv _} GczTa^ ޞ'~ ~EFYŽ1Lzߦ/Z;Q{j*NN#Osu9cp!I*-HV&E1mZ K>AmɗPto}o#ʩՐQAFod4uDpjI]a"5X~ (x hys 2/H?etJ5n'vb}s Mٙxk<.*׆L64؄zr:AwJeS"KԎ(!.tcCA1;˽%[%K[*sL3%9 A툱/ly!ݳN=A䤗d<߬}wcéyՎAxqh n,,v]x<) @Qtcz=s|*-J~6~ڡ=Zyw@/ʒCG'4 dLcmQRǿ~8g x&5\B@DIdJ_d$j *TZ9[4D:b ^O2̋ZY*zP'ErZXDj_g訯ޢvᲲaX?gyi0a:x<(xJ>l?\TEOC+O@KfMtCKA\Sg. BkwNH8?_.T]j Лƚ9-Xzb28EO]\-ϬoJ&x ѸFI=a>zz3%"#Ajk.˛`Tqw`аz=4uk]  Oט#Gzs$KT;2y ҆ο?^Wd߄[ 0>O;E'sUo$pLV_X +/:ʏg$o*W7܃]cg g1#lv$ Mʀb%}xyo>uI3W^УOShpjnCTr,3Rh7Hں dMoC'QEJۻ-"DfS!h>aL?BϕHnq\35 %]yYo FϑO[2A*Ë0\w _T_+;og }7)~p334?DPzml>N_ _XOgRS.W*L^p5 F{|:6m&~ÐIHhߨZAG V44gۭ{:w`hCaQzlH.wMҟJƱ?1QڽS;֤פfģYVP{1~Oo@JWz.IFu<#l]isLMK^foX;]@O]oEkdZ$!Uht;5|z<y? 0vϷ0 5F1oc1'Bm2?B4|LV,H BXy0{P@Ԗ bt4e%jS^93/õ(2-I7w!R#ۓok4qFI>*؍l&ib,\f?kMų!^bs<}6e&BF[`YE Da:-{_nd,ia`F;Iu=7@UvQRϔ, :?vt/ +{8*x˒b _Ys4aQ˻qE Yg Ry O@7Zr.k9kd" t}Ŵ_zP=hVS I / 6'k݉~`x%q0rWe PE>(.Nud)YC+r`ozu'ȶCOgrMuDުQ2 ֲ'FRJՅĽ7# <`הMH ![h{RJ~:CU 1%`xE=|5c'0,;f =I҇Kf!&Uj0Ae7/|詵-L-"_e4M<7yA?3 !y3 V'wЃ腵 'L:?ޓ^՗cz1wdx{"x7-5osnAJC9k Q;~6say\a,;ި.7}3+sB%Fisfmw9 )Ò}-PZx Ee*bl΍q"k?Ε8W=K26zŃ78kQZU4ԽF@qqȹ vA#a`K5xȭ3УF=]0R ߍO=ߔ*vF^ڮ!д ,[n )#gN&O8K/>cI)˵hTIT: S *њ|14HR(9},CBگN`9zMMֹ/p''YӼ> ^GZ\`24ReZ)5> {V1vةCٞ+ّ lW(Ky'{X{QNs|Qۻ^2@{*JAGMUЉ~#"w'UtΙ~[EP Μ[7- Հu44ٰϟjxPsڲgӾ}7$Ҏܯ!y?v}\b>eƼOVAlt.,(osHCL4g޷? Xw=Xc\%m{hf1{t <|K\nG/blYMF8ȳ.9G~g𲅬ǫGɞG&.̧Áɀ?%pwa>3OŹ[s?FϱAׂnȲ \176vg  oZ@{AezAS@6}Q~a> xǖB{Z gceKZ-.<XwЛ^]Ә|Mx%_kVa /ߓ@X;#@7e_teCO dwARU-9Hyp*(KF)/n!:]:؃}[}PbS-$Y\Wj& -pA|Ғ)GL?V3cDBY5|%Q ʺ3Ejq4CKi޺;\P6n OF3zj1G=_t١zqQhqKEbgYi|uNvmWbhݸSm(C>Pftaz{ڮl$ݬ>Ew׮}={27Vm gMM_eQKţ|!H$^n, <{N2+gc z͊Ao YhL=}&2ra^.c`{b;FwGI*âq*QnP҃,9?xk=XVzV'*:eÙ-Tت"Bw ^X=k`z(%0FM2UKk95@ җ\ W!yi?xfT 7{v`+lϼ]F!8|]d(} rtҋ;ňAEC:墹^Y&Dٵ!KK!L5<^{`<˭sDUK#,j<>~~gMн%+|F-k*tbH(d`ty`'z75 J CNA!cHlw?Zw#;s7m`3FP|SY7hO@n,PX Aކ_ p~4\~sց@ծ nk~pv,FÑ_u.a(ۻC/CoƎU=|IzSBXZeCU=I⩂vΊv=Λ9zq`p-,1D!j?(.eӅBZezqzɝ̴!^jns晶xk &HoZ9˟6FWA5$l "S?r}gߔ{@H # U MW`-[")Ąш@#3b`{<DinJYAnj07*5C@>!m==|mZsžV6.>fjTUOaL`\v0!$%v7:~e\saUPԯh|k- \jx,': h~*z1.aB[xL{$b0&Y^tt۵}M}1D}k!p :#^*5paח| )3-M@T1 a*d4k" 1w yk` qΠ~q}&B=Mvt׫P҃4G{ܡMF8!B'&>їI,SdT{TAtςHص#2kVڍ~dj#NH1. IQ?8v!2F3yC?YsMRi?{;Z'ۙӴ( X2ɐOb$}\9F->\_b-DZGADCTI{(%| I~,?^H )QhxI)h[RT~Bz{ğD9&n2sflAc5D}bϥ{ro/gaЋ->##GDb{vz 4Vc]G-a -vo9$g w?gxC~*s hLXį,/dF&?2n) ʠ1sq$:їL q>bvL;]ayzfXcFimEIH:y ?GK+6^c" ^Z7c*(2m4jz`lholb ϒH룢}Cz} iH_jy룀XGoceMiMn/4M}fY7Sa1  ÿΟp|ămyCg5oas7~x#=~ Qcxcӄ x%?&?}!ge.%τ#'?y#"MDl}G 4" $dJD4c ??."W8~3! $go~sA]D<= ?h@I/8~2~сKDR36lEs_9M,)"¯k_!,uIoT~;7 y9I1N?'U"!bbN62''<0IB,3 OE =)D>3S*TOOȧGxhv7vtGxzv!gIxF&3LDZp'v3Sgq$<%³ՎlD>[nIx3h 9 iLxΓCsD>.Ṏwi~7+{{T {KO#G|)y Ϸ <+ ?ID /OxDŽ'^8½"(/Lx;J?GNx1‹y^;| jK^ /ENK^I/mCx+"_,e^֜𲍄'/oHx:& Mxj+N^IjDa+! UJ zW#^mCD>H q"Df5_^KZɄN CxX<$nz!>' ؈| &!3 oCuޘƞ7Jx+D)%M oJxm7'%m oLx [X҂ȷ">{Eޫ| %=ޏ M3ߗ^D~@'i Nvv$|%‡>d!|hCfIp3"?K0&|IGs%|qG"|"?SA)Ǫ>Nȏ+!|'+> D~KOzK''|r_>ED~jS Gx§ %|}"?Y!ϺClV ss𹌄&|A|*Gz3J%(&*&m^`oXom@oj6;yӎpLIʨe 4%y=1ALuۈvYG |6a4aVOPP`k.䗳R\pܚȫ&;TBΑR(_k-7 ^TYN:[5F%XAtfL"f(O;s2脱VqSFJce`3E_*PlM.6LoK^6'i,m6*dc&Z` ?Nϻc(Y7Wd$ɍks'L&ʱ5 D̽B˪1:JxF; V4 \UZs {\_Ip'WJ4iSz2V^:6Lq͎>VEqF%y5u~[/4gyldKkB &z-#mf 'h"H܂-c,2V?ֆ@03?jJC7X FN!}x"ʌ&cux&ܻM'3NfIr/i4&״TBp~w@t-f,CnYYe6$p)+cût``hDB N$S+eG fG%ĔFXI[:3+{KTGpgH# Mˢ,,6@N1؃\3r$)\Paq`?[-x4dbTm|M޲5^DYV9|# BjjWrXԾV=LuWۜvO ^Z*n)56~=em9?:;smݹW-aHˉ߅R }y :b D HZ7vO),\Q`mIm\#Gcb ϊk `5MG=E\`7,5| tqB2 Wyez9'Gq Ͱ=pļ&QxR3T?4b=q4)T0Tbb݁|0S﹙YPq 澯͜,8B$m :)˴fr/dH\hh-?ZZ<.(]ѩSfFbbc2[.0ĀFC KL.-%bpuR[;*G%q|jɳŔ/Tso.( jh ۛN!Y pma_'{&MGm"49 ecMaN)~VW 2"Y!e2s]4FmqR_B"7ƔC W4SC45* MVb!66PGY 8>42ڱ䃇mΓvb|ϙG(Z?k7Cn*~/.'>ږ X>~4B7M)1>#řrn'feÔӜ8P1T&W.9m1i: !}Dͩy໰vlgp)*RJtf/O>A W0//ڲm2n%)-Ywd`6:4X{ `[z/ʪY-kC>xpaDIFxj r@9ً&&=hؓL(d>a#9Lv-_nƙ2*N.=|}' gL~k4r֥)?Yn7p%({/Ǚ$ $Zlڼ, K#gaC嫈:! A^7﷩R$5BC:b" tȎ>!*Xp]Ł_K4tUP쯳#UGuWJ:sQ5mZr3XSxv0OSݭ2Cs2eBahaDTmA BXb֓j+0dNB 㪊9RBVq.cEKdW!H5Rccx ~@ j.O,(f]yOwdLIz@ œe7I=-fJmOwdp$Up1uS F{H3UzCW UL(:!D͍UcءN`! BugRN2f}MDꡉwb',4L&dSI&\Q<'cy3HkqyÂW]sYO9sua{uU ^<ϴp!$mW{gL@}k' P:)SR&g7CzM~A3-:Vp4QׯC 9*D%0Y'3/)f>* i g3mbFײX+D>wZ/kŔGЎ',NWQ(;4+ j88ͯ*9}*Y7Ҧ[|b>X/:'!P^\p%<%8!t0ۡޓ^XLԫ'7#⁧-GaJP>'shKҫmEu(YyDIYu-n[R Y83 Tlu#+̿Oj`uz;6L ՞} y["F(3 U[k\sWA0YM7c :\sP0p+)I: &+ 7uwLWmmoh 76[Y$wzg x  x״Lk;U!QQKVJg~YƇo"oӣd8.N+ش[^13xX ʠC+džӜ`aaLRv4> GlՄdђ q:|kf{8m +?ǔKj()Ca]v gDڛ{0)cZR^™wE)7BW5O\mGoXŧ8R8( dRCRZKm7:p$ 댿ߒyJ4#>WR .&: uuQWȢ~ļ_ڝ,6S*bk֪"g䗣Վ0.$>Pe* RDaZEiE@-19UuMTែBB{ȵd6eH[0nT%N{EE  맃K}9|)QʜE>^]~ J`ﮥ >L> Ky5u/Vۯ'[}hE,)͙^wfvZJYOlFZ-O{ ךT-^DՠL:.;^ӋgD,3TI(Rr=\ ^044K^\,30C[ C0ܺlm5(Zn 9Xx!I(qK scH:eMz]zǐ" 3sgHATܑHJP h25vj2 >c@1DSQ8{~U9Ң ^&hg1t^\c趨@[ ]4AbIgcr91(]llM)eh@At ԡ*u3$W]kN<\ttcnJhů hjA{{Jrnl;4f863Uho_,whC]E2l֓( 3ZT:O:1/]rfBaO>J ['քoQ0[9'삤*1 :#) eJ8d@91ךZe/%vy=o  v(C @C}-r:/dP\U؛X}x(.W|- UX5Uy:.?6n'͡ݍ8PΠ/99}Sm0 c" &=FuMDdt-nHhdz2:b dj?MPAw&K݁W81C|h=2S.'ʝ0ˇ?PX!XAFٿsMd.K;HEXJJ^4t} _ KoN[dSaP팫8@GteqhA hݏ<1lzhvs`:akh> sRա5}H-FZZxdH*3i{ sGl$VCrΌJ?ɮS}^׿^8QkFEa>;+)SJ!L5\*sT쿩\懳׹8qnlMIepiM\)~8Q.:?kzzR$d2=,VAO ܲͬs2Lu`IE]q1h˶c,O*~O0.ђyY*9s*6%ܺ ϟ-O-Y57$VZ\޶I[``r܄U AѺ¬w{z5&tq|ooh pB(k6٤}?%U 6w=G3 :ւ46o94yj/95̷RŠ츠!xyO? B-/S⿮Mw+<+tnAKδH}fiK*aK2|yb)olML@jww2oؕ]lι\f'Hjj2ɌC;ήolu 9ɨ_;ddDT^d`T^#4Na^mA(tQ ?Bf/0URL(Z0Pcfx+鉋̙<=I6'T\-qSU诺UQkL#`BAj)^ ~lk,hUt:IcKMysBL>BnAX3nOgM[v1" ^%%s;ۗW[L ~.+!ICǴ>gm52ͤj2[D@̰}~F4^Xթdᖟ mRaږGpa"t Z30qPR$Ւ fIݨ'mi)E|Q|I^P@EU:Z߄z!8,O-ik S c]\]#g#[Qoƽİij -h)`k68eR4o|Ѝm Uq)0? BQ`sG7OOZVu@J.U@Tp( 0UJDj/TqIo'iT]Biq,=j y"TB Y 9j9SzA,/zb–GvPXo{U\:>FՆi?A d!5脱@\E-)ou Vf_V oZDI W HZwQGQAUVmg\Cϥ ISe*@ }+8週RWzhQf[R× "'Xy'W[~AAg=)Hȳso}mkzs+<%/6^XƲisER.hsq?lN|t-8 =do=ɅßoJM)x`U44SQ%Ds!lI\G}e߹@%#RС/FaS;@AjPˈ.~=jdjb2aWXjC$U<9{HDZ}Hufut 1;\)=fdt`F;hȷ83o=`oE7S qjtaeC0\f)i@ #oԴPEJ[ܹtXζLRoZa<=[ pyd{/t?bjVS. ,ϺsC֒MbEaf *w4$@Ӟ{DD/کUT8{\f7x{JE?wG1 ?^@xïZmľ$p$W4Ϲ,PG?UZu8}#= &K9lNw~ ~Z_ *ɮR[&d#PGğ9/͐l ωe]I-[Rk2èP괱ÍM)(@S.V*g:%P G)ag̦>n%C*Q8 Aؓ1e2ꠈeb eeMm9ި}!R2Ÿy".cL@ %&_ W$=_y)c %Kħ}kgYЍ1/-_;|EjQE℣+xo 2 %& X5A|] jgU}D`4o#<(i6|SkIz6wu,9=v:QBPJ3HV^d]9WvtTjgbv~E:I,M ͐I1d}K?\WB|D~OknA!zqڳ̫Ss:'V]4;P1}SwHfEƊ`ӕ $oj2"QQO8]tl-%9kI /+F])]BhF\^h?bQ*h5$KHo*L '-q^x4Th5 T!Jjo\E@aH>tRi2`+$'FtQx;w~mX=H K&BfdA +Ć!Tne3=]`ZPlHr'0}0,u T8N3wG}n=g!A+nQ'_"4` ]V<ɨg: N-pdd);ЃK2fN^&ޞlXgsu6YaFJ4K~$>0 YZfPortfolio/data/SPISECTOR.RET.rda0000644000175100001440000043417413630677273016053 0ustar hornikusers7zXZi"6!X)])TW"nRʟoÞu:GArտj{0mq#+"pPܹjʝقrNmCl X/bentZ_@Su mimG?N@²y~idDRBM壅3h_P0+\6pJӣ \lStfafxA!N M# 71 })tV͓1[Űjn.% Qs@x o -}Z< 6(Gx"FHzH+ ]CqCl1[,4٦":/!mżs %5׻Iܖn '$3@+,r8oC9|pnu{"J mpB&dFF"d*%ۯvB 1QX0Q^ Q_>IMC=zT+i]_|YE/cݷ*aO1j(ݶ.97شcW:KmIb85N5w /e~XHSjԢTBq6k>s <|'[`t JXv=3]-1mM ws%Dig)V9svܔc5P:*KoسF[dvrZZ*2<=h{Ju2&ނ| Lzʷa?P6 w\ڐQڎjh~ x}rVQVa>Pzcf!A%w3ilz H][{Uu_m3LOp2QGK)mT_0ZE-}1Ý;T:Tvo>>\( l%V= wW;R͇SVrI)KV b?qD;/C:ݺ#d x;Jb~B#ԮǦGdJZN)AD)]tHJ 4E-mѕ?!āΣ(Ҳ@oyuC2VVA|x7*RQY. u_kKi%n"4g/^7NUj}…-M "UL$+?bsHE 9{юIV#]Oi.g3: 'y4y:ѴGl7y _ICX.CP/|?cJ +ى::Ijv]s ҋ(?huuF yհ=tEbE^ԵU_՝ V@U9N 3~~ _ 7i4I#Ȳ.\RfJXJw9xjzmBV (.c˟j_>zxM3{D JE|9]ɵϊ(6_>:ۺ~@/9t=/0taJbt*J 䨋>V"po!` ?Unݪ':XrP_"LƯp%"6o\$0Qd]3n9Ë3GvpCWC+/QuBV1#GQRr"V m>HMJ.@\Y}*MЮ(5P1^hYF@>p4|Qt5=yuAOӐ5U^ʸFҥ"к~mpL=ƏI g8dz!ʪC51o?(@yzA3%r]Цy!5_ P؝im=D"XJˣ &4.?e\,FC+‰#uH1%ϥN1ieh*(A۰ܲiL_}F:jgՏw Q0F84 ^kjU-ڛHCngv-\zrKk"\Fo;]D9nQjMB.$Q4OxOi'Rضx)háEI9kŕ#UsZ;?KWFk]v~8~=|sr/\YaDW][B.\XҦHk4x"˼ޜ勃'\1qS.n 09C51c%'Mfh@}Fu 3>d{̀d)`P`۱e3ԕYۆLJ;XUNlqU7n'AH]OlIڜaUS盲11. hMqcOӻ5p_KYR84F&q5lO:~Ey3NKCaŨymN}P_ _rDQ< jBؚx9 qӬ̤' Q5t9&CK)Oڂ u(:JJ|Vȇڕ'1s;7)ɟjcn{msC-/C*ޮiw@:$G|`H૽gX_ΗjL\Ɯ]AY4h-%6$idmWƏBzv$d~I\zO0lu$,jںa׹EzHi>WFpRf"q22FEu-(9st怭-ѝvw2$AVX20_; fPjgVxof]AfRJkA9;0_¥!h'9Eq+?/ h;ʹ'sIaygVdz}} $aߖww ]\m<*61!Y9IzZu"'Kq9s({CС熭Z q=6igCm"Ͳ ,-l枣᥼~/E Vn5_X@;DјPϳ yUJk Ee')eB_{)8U7 ;0箶n%mȉ:;qֿdP% ǴiDDEZrǻλ.JڞWN7YJӃalû"r{eQ.rم.R{"R%fr-۪9MC+4n%6^qU@]qdT-BWbd}y33%/H Y }kۢ-fa|TQٞĘ.]9㝮BdOKrhIQ -h$OZ{Tfϴݽ]A` mTt,fn4@HRg'S.DȄw8 n.$@"t3Ȥi/+󫘽7 sN65۴DP,!yr3ʱp 4%. Q=/rиaa7Hrpx!5zvhU`l56*R7=_>fpCq6Ķx$Ćc/ ҃` `ZQSv p'ul3$Dz:SzmO7e" yKg(j*gRpC7Q.nK"ϘS fAw# S懄Bh3'c'L6-vK j u ]{qh1򷲩& /b^BO:\U~gi1ywZSQ,-P4HDvJYeseUPxW,×ك>õ18/-06-> s],e jHc{Zy,>|0}H^s:ajoH 'yU`2r,Do`#" g +*$eZ+_Nȗ`kƱ 4 m1db<}U匜`|3goA=!c_PV✪!CDOJc z6;؍ 8u }s2{z!#4OUd@d0IIiUQ9סX~z+ XhO5p.c,bITP~s]WFE?CiLs@nE~F++3r'*^DEXckV~޹̋(%!I[SQx.m?rZV,Nܵa So؄~ґKLeᇚhߴb 03-7T;V_!"IeySVPZ wO|92-O{;9PYᲆ ixDtS* 6<Lu'=F]C@473Hj!#7wv)q{D@l:dW Ir߇VMK ]?#7`V|Mhxyʭ˓L8fH.'H܊;7ԝHxݪKBg0+xxAԣENSk2wћL]uJL/H)f˽ˆW6N*IH<99%AUn}u&@w ? oxlTF[E jJ|g܎Vhz2Ob#ɾH+*ޝCC cvy#ߒqQ^[o꒾Yz-훦Vm>#YC[8Hh}\7>LaeųA«Z<֍g!h$lr.JJܷ%flO*܃|~+?!p@NKȁgaO5{BAW ,5WtwvJf6΂a!uğ^Ğ~Ow<u[(9 /@cھ^bXƗxx=<| 0ARc\"޾86]ϫX j Fp~ݸ-ocqTΖl%y.RȪdeG&am )^a,ݩ҄-$\7Mk]e2;.Y@\Rew!m0yvNgYjYXJY%[GXU`/^m䕃)^tmIٌj-8UѾ%qbF|4CDSϊ+K`aMSBHsj? G *ˏИ&=fgeeS^|aДh+T\] @53#-xoQ+$ 6Kj,6x-*N@AW$wo(SH{)-P#.sΤ%Raվ+Mf4 ]dyfRQR &Sņ2d4A ݠؙO V"-cՙI3<;6,#A,u\+(*^:0Q6_ܬ[Q;G 6{2>|8l.eB1@&vщq^Ɩefg/' y\ kcNȞ 1W`l\dZ҂'l-o(Zӌ++k-%ݦpjdK ʶǽΐp!/h˂igw];{79"gKxsQY{[j E8L0IRqD,1B溤CcmKZ .28kOD' x=U`A@k^:Y-҄S9A;#r=Ԡȟޫ/euFw3&8)ʯZ-8Ǿa͑|=!Ha盳J)a3x|BZּ+sN&~9U toy[",9 :~1_Ǝ2XCrd_&0f`t &h𺣑#i]a}-[HbpB]6Ukb.~iˏRٰ7E0g/ηS䚙T^J/A,*cBk49633|*}.'\yE\yŪ2&5A# ? BY#oHQaHwaگ1Zn{C~m A( 8x'OUvbw7'd`̫z-x>J+X! ְ 1@ 2n$iaj&{nGrb81hс7 ֑~i5M[8[ y 0Q*)-*Ď.>UOS]Kd`Hɪy\OZ1!|F Kw2[Shz(=!V'o`AELM`u' c#Pٸfe@>717c>g)w3*i1~ͦv~X.Y4=.W=|zcO 0+܋--7-ѥpc-:n7&nci+ Y\9qII W0>HԫyhgO? ve66Cb}FF{k%Pb%19ɹYD9k-j~>Gum߃RJlkh!À|LCA%]b%:md%]Ub}ܜju=maB7DoЮDQ q6(tex#tQK.#?YJetfeC+Z'M J(0eCrϖDv3?Q&1(N]@w吓 9HFfDiE'Nȶ:Fa;U:F GS@9^^v ie=rb`RLE-)颡YϺJMRuJII`flO/)@rM]^4F{z{|{&|%b;4|l* BUL/x(@{lʃtϔ{ L*SySzϚsl'p_1=QAkL97,^I&ljJRP6k<߂>WwuQ'PX%`Wuϡ|؊5L}Bp@9rq.F屒xB4Qf%HAL8X?uv>e2r~LL1uZI!Kžoo߹abt J-:;\BX@}p!o2W +ytXG'VzԱ&X픗À K|Tg+!ϱZf\t%s,6ML?W $an6`"1g?2ɰW#$Ee;0A0Ur/dA~Cq^u/%@P4ݫv3qv't&d9Y'R%: Pe1?f危8Bx0 0S)shZ _U A@D1ǑтxV7wdqBk7YPᜩ0?D `mQ1ȇ/N\K`V2=>g:ƢxWA1m~4@.S|\:}bNtY,9YN}.J8Zj!M34)j޵p(Rt~*ї&FPυs ^2Yzj34y0X||))=rBcK'R|*~:ĬtmGTLҰǀ!o(#-%c[N8,nζq.{MZftML9s,cU ѳ̬SSΊf#vYcZ*p^@\=*9t^$Ŀ:ǔ⊰fbX#dÒoY2e5<5>bmI1R6%?^Ww%ArhO[3rDwӽwIrSE;m7Ȋ(ML^Fg1zԛ+a~o ? Hzp~CE9,AW@)`W+r{"mr-fjD=ƺvpbJ Bu'It)fT02 QiNdZD+xC7oE}])jH/> jFn{&wqFo;Xq "!xe3 'Q'є;hIRfYwV~xRS]|fs@5Dxd\r6*fNvĈ߸H.v9 !I q=%:~Ay2xv䠘?%Ҹu>хŤVH* ."ݓvfha o֞U)KXN(S wТ_7|gI01Yh,1.0d 7(&dFt?ƤN+$zwǧ轆\4mp&4lj NYgluo$[K a,HpU2ghDhͱ_7;fqj z 霟uj-A 菧mwpy˱{{'\Z#Zx|!}ȰN}.y"ՠQBڈ:M< /I }rj pP7cWߢMin뎚鬅sLv<[v,KEI[V oMˌLԃ3vE`~D Ƴ0h)[]dP΁Gj?נ` f6<l-bׯD0Y, J+utA3jQdDRg r124hf~3e1[TԄJ CN1GOWZ1l5:a`e#7EzN HobhkOKTmCگTiUb_:z>{[<ӏ~KpG#J|(֭MEeeD^p2j,2]]^u$[ezqVWzP v"{CFTIZ}Cd3O =sLkR m s_\c AuG=ۜiZ|y6M༌\{14DXܘR5 u[BwqPx& _b/=#Vc}ydc bAы%D괶ӚΣΞp'W+QT;څΞh: rwȸ-evw\RzTSG8z Ʈ^K+8L X:i3SIǧhYXmd&Øh4>/>54 MRʫZ^|-<κd;y]jF|\.$u3uPa$VslhTQ6vT g)i&B#vyAM\hK{vt8\wZv߻SP*E)M>q4pؒWKR'6?=}0t#xhzc'VMO K|f`H=:t<~M๎{Lp^TkZ/_KIgʴ6W/oH.wd"K{>2w >e@}bq"hȷZ&$Cs@CU|XtO([tMJzJu:b%wӘZ642L^~ƖZ VnR.7fDqah<̈́,聿`z- -\ubF*ʋlw3 g(([|!~ oYǾ)kQk`+%_B0r8,&q3SS҆nM@_[MnoZX>9xIfSppGj+␺G(ՂT+q N9Y#iw!z(+9Qk>UO%zR&}y2 LmžcW`M'?*) wQiR]#mkP>%x#9{ 'c敹 DcG90eWEw^lӈŘ7bP3yi{#*tcwd~z.>Ӂo}0Mo3'L(X)ww4SަyS"@%+א}xR,Ü.|31nDžǺwmqg 8,?9((2t,Ai* 6\v)Tvi=J̥Y%U_V$??Nx4㺙N!mbWse{WP;3L ̑=JsJhtEKCO=/^jkK qĞ+ڷSm>C?ᅒQ_"=#0}#U!Go!(u,zi̷/Š.z_3+\jق_h7V%c_۳IGVlsdZ%UERgu`&ҜX,Hf5n\ٵ>0czZ CM1j\PSf^mEUr`CRQ+_*lzve j0,u'ͫvg1^(o)?Шb`BM )WV|-;ڮd}W*+Nl]&hv4!2-Xm~)lsv84!_BTܨ^βDK7@.X]~Aw~ڒ}Ʀp~Ro ܓd_*S!f%:^y!yAE^DߏЬ ӅS,@$BCƄ̳6lbu_amUmaM 4KOl\z@P):ݱ[<6clr2:`^q[CPzfsԒlWYN UFޛGF^!Oy*]G04wn߬ /Py+L~I{FE![F̸yJ\~l_]!slJ,עJ/[FI[7k$eQX%P%KJa9^Cmhzʠr0 49z"ɫsT;7ݬ!uNJeZ) (^},!1_iQjߣ}}&?Zx)Djz%E@< ƾx3t `f%P#nܑ ޏfdkݫ?%b!SEKL ȫoþa i`dSk8A*bKt-A+xF;_d艱mN]ۏzA*rHwA["f>ϡ]˝8Ua$E[vxl?koRAVɒ*[(ۮX;YGk.A)_hccA :Quμ<[-5oUYKl)ɮ niוKp)6׺N5?95q kS&[J\0CSDX:"kR` UЎJY17c{3\ϸ1#8B7l #DnVRU\7P/Ug-ٚw˕ qE,Px^sZ)3С#% r:J QĻ\.A^O#JӬ)iRFi!i)73xe $HF9LVs)0[R$kHB 1>4qdoYAݺ g,˱VBr|z`,/ }!$6qo?EI9vw0Q`fuP\ r BJq_Z 5FBՖ C.z__6)L~A0r=_1кW')uХiHcF)28H"{G?^0tC3tz!/yl%"m%'̩'E߸5M0r?!5Ue9n>vD$  C[$0j૖f4*kQ.ޙG>m+y(I (lȴ܅`=Q*I~PO`X!ſgU;v= T\+*F4}+z6աk)8/UyV_% )('H!eraK&)a#V^VxF2fbA^|KJe`JGND*Ja9w Ùb%GSkuB Q7LL"yjIs|7-m?d&똖$3mkGKTDDqNQ] ,XF2j &җHܙֿI1{h`1%ٖ ` ly -*?“uI"O*)>>&GE7I$fB}a mU~6JUH1 GN>i&_~iPsiCL2`>K]M7m\ qAܞc7*T7~40#1`Taᥟ-]gt9 A"7a@Z0 m ۨ,Fȃ*M7yz ʱH%L^xE?bTje=iF8CՒI!xMnEs0I\|7]VHd)69^\\ggЉ!Lr} »V{eJ0͌t-QT*f4QupGՋg'~=2vH8”&xʐ?u/f`k&kDwD[hF ]!؋0&ױ@ &Z l"}oXbol;?4o#%œO_H@{M= UޕaYfXMch(J"mXQVe㋗|Leq +u'Z<} o# ̀٥8N|Ttہ_ eklEmm'˻~-:mX;L]6&̈́PXU@=#w XY+Dkw -DYd p4t;}& t i!*4`R:xU+@LL$ >n^7,y^%6=o yT+HTƿ/!HF13^Ŵ<Zr)# CZ0/f,;tiTsLqAzC&*D\B.\ĆA)i{3^$qqto  'c4Y3]Ѕ)47XnxVGNO@8ExBQr]w-P>L2DI{%*B 6ߋ­ n -7)B|hpڦ*",uSX*eØ〶D3S.btvjRlĞ5t]<\1Z}^u'954D7<ǙwwSyj}*0,2J+և!=&~M{fLxhU(rL·[㾣 ;G\_@;< S*!7m;^eKĈm  pzȸ8N-O Ł<!C ~pX Hh5r0Θ6P$-Pe3C}OrkKs7:Ӿ4vt6?g*_i@WPMw4Hs  g:B2]j~MG *Bh邭Z&Cws 6D{]"13CӃ[{OAG<&%[{ѧYkSVkx<ȋHBW=Xrƽщޖpxzbg|R`qAl/Hg }רDK?/|/8!/p;"/C Āݟj>m*j VSLZ:xutQ}/;][^amRU훏9@;ܵ`v 1+DYpe+QQf keŜVaA([+lT&Uu3e?w'\/Qgf@*H{^ގtflZonVg{|:d"?syD>xȋj9!29 YπI r,MɶYgKORNԤ%w@p$]R=V3 m "V:2(E?AW1焅ִa*0?TׁH2߄Zxe:n%? ;grd`2B{o tr3ݻ%T'`*Sg=5&{T2YVX;IW,9 N!5Y|kG=yկʉ/:rh. sas9ws~:i됱@C~E|bpUMVΊJ[Z0AO3:Ʋ$ C]Db>FſX5y~|3履44_{3"+kg79wTS*t(H[=  _ _{`xF-m>:tlat#T ue^`f֗A"9s#0uSѹ5$J4GsMI3y[.5'Id"x4q-Eje.S)Q T^Kl3rW;u?Q5\WA1,8'2ԠZouC-ȼ'zek|̵hIhd|LٙeDrȪ% 2Ʃ.:.# %xX?=RyNӅr)(k{KES|zyO/؎b$0 RAZ_r#@n{('6<1gB0C2ٱP7hPVqY~ڳ:d:t2v4Xjoߚ-5Ԉ%jl*H25t؀e$XU>:]_-4(oAZ_Â<)Kzq_m wa&tъ(j'A@{'4w$cD_"龁L1I'}۱ylu'X\AO/dǭQjbEyڮw;Nպwm"5!=?,V&9%+pv/ಕyR%o܂5Ӿ?$m$inNYh):!:hZΗOvpԏӰ@KjB8g2c_~"#:EW^݀[92{&TQk]趮;օ \ͺr14 dQބvw ѧ$@_t%s{/akL"\2$J*։$:>hG$B5 T ߜ%T5*"ΪەMVNH7Ȕ#^=4Җ@YPpӱ02j8);7Wߦ'D$RV'Si ?SK>qW^_~Jzdg,RK Г ]DwE^ynJ^ vݯ}q~Ayz<ԅ8).OsgtZ/)zh}(Iwu@\\C Nj.p.Afq}Q輞}@RGuZE()M`额u* wmEC/Rm/8r"ӢWyC  /k4~ݡWpI,莩61`F.bma*FE #:Vp Gt)WبheK`LEhS*S#3 B)ר¬dLJjGi3Н$кcs`ºƴMs3'VK*TQ:Z*d#"Њy4]‚C&R ;M+,2#]gB4߇O5C9e{0NZvgB>{NV2/=':b9)υ'YI4BO =׺\`_M=؛uڳRE[S@3$D"7׬٩$ʴ6_:zA&btqL?chWD'V[x^jFj4kީފSo{ *~ui3,=uSwrpAPu[L]kqAAÕ$:"lDgOQt{| qaO,LPЎ2yQD ĉkS hI1A%=p1 *x=c-b1Fptg-zؕ͹([]ѻT;l`yR3/gK` qP/ di+RUHѸF?~0#ilEKy+%Q@|Vkl `D+Un1 t4ی7)Cb=K Ơ]yvpLqaUOXl=?.tY)@1^񁩈D ?躀ճVçU?c=K,&Tt+NUHHcOΥRpVvrAwRJ'MJ=xrCTq<,Y{с F?OfRXTOYMw)ܑ:e, i;@;?X Sz%/;4=oKc(ks\PpF㗁cH:mW @ Tdy@oTx6,u~hӄ . ݽLtÄ́فu& ن騴]FfY*gOuN(6.AwG/ '7$6NoZEuLxY_xIOz3I 9r?+);"V]kfܼFD,r鳥i_hDO$]gzKܕϢS3Qq>?55ܾG`_E8|)>pG[dz.8bRZd$oheJmE^#Sm*.F#3 dʠ۝J=sK"2_C1mF@Z`S \'x r!Tԩp5.<Ω$@~IubkPw*3w|KbbXxm%Ω=(9?TʹTHR ~ʓV\2"AK1}l IݒѸ 4k jfL»4كo@G,,QbBˊ9O i$M>ߺw]" (vE~77Hur ވAR<zITsuZiurz^h\D 纝1!1i4694ve_!`@AqLr!Y,~"EЏ)B|~;P|[g/ Zh*16Gnh<щsd+N><~Iqt=l|+u {1B]^ YڦFVᭂo: "knS vz$֔zNC"'kh*ɫS2}h`,prv]QMTy]~Pʰ'Ix;JB `Sx|I@n.GB؅xYK x̐ʵOH[Me(33 3m .| ֓^ev1=og/HS?dչ wMYY̰`IGٸen nSa̤ 2rɨj w"vF+0KC +bL.Z$%Y17:st=>%e۟tݧWxGa 19fK=Bkn=(@zE+LЏd&gsU7ɩaɳ{6cFHFxܗ]YA`&l/@K ̢E{3NPuXFA5XIcWP;.uWzW s*cm6LOKV&CUyd9I/Hu1$eJY|'8ffT*z:zIP%!nfN*˩kSa)jϒ@ 6iW*Քw !E;V6 bFɲ7ijLVIX>IFŒWo/Qh_c#'&)-2TN1u*y@bD7pB$f2Zofc'UŻ&8>fP:ہ R)gͰGԶ_cX2.fu8DS@{#GP 3$OD{oQP|~Um4 &lS ""Q§.eL {.7[!_InVۄn8/sD|*^"-aˢ34%Ξ}] kU%%d/ d%bp=$w趹ֆ(UάOxA;C,2Nh5dCwr6Q}O*9LkPOɃxz:;CX:7ѫӗB,56J/=H&ԮVuykMbЛb 2 U Ko鬹`{}3[X^ l߻OX 0Tu4o'UWZ-pOU_(Y[+D7V$o-NY$|h_ݹmع}dJ/+aF3ƺ @$DS;?Y$QRSBĿ ,3.N^_-7h@J cwHkv׏0XbhBHS W#UCN_S (:.DFLA&ߥ[jtp[$'q?SF9`z8@ !GˆhJjVkA?V>~35% '] s`9bVg[xUvaorTnɡ&/Ҫ7qh|y꒍d ~&iF FV_ڏ;ɤiFA`zlBgOm'gbvf D_,{B:@W7GR3+y0$Έ3M!O j@:pc;3)eaxo8Pp^KVir aж7L:>>)e-aB7t;,1إ"rL{h2U'.= n)o*^-o$ĶeV9;@DҨNs w);"x͌v lVCW8l.|PNYXx4¹]0\I;]tvkUC/z' jڿYz(_pw!q$W6v{M@1Վ,Ea47NV\|p3lVBFuu˒ fǐJLge%R*qePa{ 5k=OGƠ n\ TRSÍo+6 <+'SXxP 7C._JjigGRi3ymϚZOaI6f{7rAEK<f%0tfi햴*Y`"n>"?=8!!{L.IP*lC0Qyc %b tM+'':~i2T|Jdg|zsoټqT˥P,orq,fKde;?,߾GO/elɔ*!>dBB҈!úi>VBoٟM&D-MWXEƼ-I^jW4G,904nt3 O%C#4IWhuxpg~Frqx+m6C±ua ʦ^O5k`0\;G1(3mHӰn1;(RҬ[_ۋH~cD([(Yuئ +Ԙ)uqmH$E[1ӑ,nߞ( /DK5Ο-т0lx^, q@e][/{a%^4;eRMH^,6  0v +rB[z4gHۣ`@zWL-iXD '6VPv6ˌˁ'e61Oʪ뭘' xWsrc0NJ*#C׳Vc; };?Lؐb,t⮛qg֍*gJzQ~l=׌7dǿbbK<ͤ"yDa31JF|)ZNDkZ]hb}asEM ) K"KOVOT=)}s>.OTIhiYópB Y)ĻT_^0:Yz3I.;^%-E 2jN]+w !Uݩb9,O)8*gFyQ9>1\$X4qTԛ;Y1ȉc>% Rǡ?kbFcb2 v5NY:+ !)0$Z+byM6 `[dQi%#sR\!xx.MnRNT˿zXWTWX(bEt}wf2Y 1[yvbĦ8Zy2f[Pg{k̞:M0], @Y.E.$7'Yk7tp^~f?[8,+ E\}4?K$h)Ld4u^zޒ4l*Fa<7 g(@hcѼȬkQ }P=eSЇܕ+d;_Ps~*:B{$Е&4Ҡ݀lKSMloCN`i$hjIn={.jy|W[a$E5+ܖʄAmpvgMvSJN@pttYM3 Gg)z8֋g!fw%VZ0GRk7JsBHtm# 1`*41 EW/;AR UrIoff1s:&Q=Rxp~Xź/_D[ TQJ6h?¾9p[Lrb~-3'-υv xuA1J=`ܚ 'NE OvQo ~'yuSnE1~ok /WTm9 x% B G8&&1Sh9FDq H͖1JSGߟ20tca(U]鹅'ӥC;zq0\oܐL{% ԤY㌁ <"<ῥSL3v" _&CLu$J:AgQ7aOݸm+զTtV^fBfjBag0/⅓J7a{W}8N21:eҺ4 CgfD%L_lPle=q7ʱvT_W `";ˢzBNhl NȻ?i ;/HmIvG E6ԪCZK".фST,\m"eȿC V3B Ø| SW *]_q߈B"l.<|o9w6ʤCfWVDo2"b`('A{]J.ɋpt HJvd1B ]>lʤܴ c)Z׷LRWH s4l tǣPk5hAbm%ҕn&wU<5 o%wŗ2k5Ov"^ʜٯ2TX9ÙgHlri: B4~&U4^p3!H>(s`;w"ѣźJP˲,*,3:~xkH;Ay]ѭf{K"t/&51E8hoع#LK8ALN7*r"=m:KoH4d uV=D/ @I,joM`u[᾿# YQTLIXԛ Z$͓guIAaM.tkXɐ@Blhq IТ ~4AM B/0]))-cy`%g* 4LC N62,P:'y]: K12bb4'>8zʖ>Z^: ' xLdm1BShk\tʧH[,+;@F¬\}I`{%+vLf&\R!` ^pf",G2y@T] I]i('ZUȎ,78 1F9mBF<$]ƌQL5U}j%~>|t FPхĐRw"ߐgBG5@G!4phs#<۹4!CCx=BX ;eEu '3z|`>vRK}2+~g 4k $NfȾXT͉Z+턾fpͲlMX>hfBQ=r-~[Q_}S,%9w8^|Ls?8 $T4|YBI9 @Drd`+ZRiv!ȑ-GcSS59,אIzMx0";jp=7l;(8nlL8:!IUfgZrg*q(LNt UVrTY4v8L7,/ʎN#sZ`/HvJXsK lQh(MTg3h4/߇%sΚ0J͇^|&OIS,J7,B @c˅V[`u$M1ʈ;/=hÊTa#b7),/jY5`R=ks}F72?~`ۼ'ؿ\+z_*tHC40- %$5xٱı;9CQ}$V,|GRD6uېN>\{.di1͟Op3*2 ![&@g+[ M Y6#dnls{gW -B5g)R Zmd i=ѩ݉'THeS#`Y6IRBSjkL>SΕ۲=& A5Ibo}sgHR _?|fax'k&a{.i :K@I] B^?ϗ:AH\śjĹI`@'y#I5._٠nfۋVX~ M'NJȶMjV# KArXϧ/yn-e@kJb?wu]5do7@&̚yҝI.KqC,?  nxGiBo'D&M_~zי%R3zDF@qګCtd+#_\SUdVܵ b9_&\x>GH(_/6#3z_W$lk.H\:[pbB[ 94ꥍ=2FΈrMg'6hN6:1y<-r#&]=G @Q~Arn0Pe(#.W,t{kYt[H}Cehk7B ; 7e~H–LKFF˲`~o'ĮAh^<7O`Ͷ7qhT8h bv?yyl?CU=vxJO/9}ރnп\>c7̠g@Mi@GֺQ*GY Xq|UxaHc+k ycz( VUyT'^~uy7sGw \>2TJ 4Z2[*aq9zelງc;y7ahBK JvQ80* )w s!eT_hc[}fBsyrPUd3z`Y+-?ԣ(;1kZ?kO,TC}bi\V.\2s;3?u>b- E$7^<61JNE::b/8H#%UitYC N91B@c:K(z2PAQ:u|v@;M (=EO& >_ƒ9al~)Fԫ <Ipfl۟:]gϥMYYi7jFexrݚaf?fO;wNM@&$Pt;zJ35|^#)m@ϹH#Ψ+Vo:sjCnL4 Jz8?Jd][E%@+\Y&du3(lR! ǭwO|AloFz2)M &+YwA Hʻho(m/"1'sk1 tf&&yl@TNˋu#n;pxO0h$&4v6_{%9whu l~YW$䟐4@0VIϒ,om-'9{rf6d1)4K#2L]jnƯʒlwo+EE{|WP~#z%ea^4?7|^R-oNvd ZVSe+fN >![ZlNy3Z#~LF'D%E R"ʖG~/ 2&#]X$4t!?IdS S/EN'eke$`'< CFTŴ)}}P/v$Y (O\y~+JoQ@vj, P-MM>9Ww0rlixuتNy j"K֮Sz,4XS3Be夔_%sM:)x?Ǡ5pVDuFpٞdJ%j"<ךg~D!HV2hn?  ŋAi_)I"~֡jp04'ZiYTlI)I2R˄h|& #ڦxJNc4>}aO1H[;w@Z)hE5(&vUcDDEmP`a7j`Iv428 -MH.Dܯkf[y0W G~ϲjVk#yt @a:owXl`Ku ןY e'0?kӠi?HxM F3sG"Y!k.d?P=}x/h9:)Glީr$(cD[%<,"ĉ_ôeeqݸ9-FJAuW5Q<[ (d ʭ9|*WyJ)CI:& L9 i &eR)9oJ/{Uí< ۋR[`+sU:5Ǜ`aYEvX2#ܦ3=Ko$pOVtDPHm Bk8.?oWQEJ|Qa\ o sJڈKɢ*f7j}xȃj0MHqfH9,g,djz %: N&lVHnnHBɉ낿/ WS,qme1Jr&Cw8B0405Qvr(ԝŔdv*/9P[vϓ;jʒx.(n%!L^MTP C oJM8rb-] /`٭w&DȔ -eJ'@xcȓv&X^Uq1dN71b`–;7sB[ǐhC N!__ݸ)xxZ;>x|R8,ʇ$3eoQhL*zYPG)/֎ĸ19`ĉA2Z7nUj\rU|oŬ^ٽǂ` F՞, RI:'MDv ؈Z^H2%rޙJnQat/wb%l0s0*ˡ<.뇽q(0z7"~O[,3&/]*+hglacEX;e, SToG"yGiOh iLJIhR`~~Zf/Qld&1o0,uķ])jl$Oſ {512 Tt_ç 1;ԁ+ Oʧ@RaC{k~SZԠ{sh%uEtqTgS3xS6_(%y ce =oo|o$rsr1m'd:5GZFQ^0sd1πDi3l#ǟf^BoNRxkׁTW'@p a1 X5 ʇI4ǢƫO̮*ZեMQ;(M8VxA+vG õ\i9kIx |f VY#Z)4lkNegq$Yۙ- h4e&$f&J2}?,n4Tmg|7h]j+.&%bG'[M3hlgᅓ=bq(\D Tv g4'=`5iy1û5 dJT#Rۍq;XX{Ã4p(۩݋e01qJ\k%`UXb9Z vG\N,7F],N'-D5v,AfZ ԯO^ ZMVIB$" Z^\ Жq}EwehA[s+V?jZqDfqPu9N f2d cz,}"tH| ,ds#5Ȫ4ӣ%|]|.A;ZH\4K,Ej8m˸+?R眶kkza^rF b8 9C 2=8>@.K\lswB-huYM,kQ4@J @빇$ut whL$ NW* eO"xR34/o*M+]fvpo$ .MUV%XMqǡ{gdr [w窬UhF=GX ?;O8F/w_1{9%. rc/x#`$\z|X ||0-CTBd{[9aJ_?jNp yQwgI/@:1yWH3K'` 9}y':^KzCL?x3460z^m)= #cjU,8 2lLZN E A<WMUs?XG0EfB#(&NE%WP2騜g@-d(M5mУ'b"n6ߋ-Eh:d6m4%@[Fy-yf zм͂jQ\K;'&w 0"O)l\neJGq~8;:P@"]YŬr lL?0a|R96(orc[_ ^=Hy*"Z4 瞭u<}6=Z%"|WtX ![ԋ:nn c=gL*B-Z%ϊσ<=}kzn$0Q~S$8 \#O)PIG13ϴ"R1frs'xc0@CP7P<ҁ>4&!3 ec;re-ӧ;hC%uqƂݮ7j=K@|ƪsKb7 y_|Śe_la=<i>>>SF^Jbmg$Wϯb`ˠCZp˳Gz'pqB3: #`.s01ֺcop/xq.^W<;(i)XqzX_"VʍUgЊֺ1Be]l^:3(rxP3[ht aɤtUbsvyLDQ.WU yƔ#J1X@cn0$m4A.J*&6qe^ XC}cӃ2>tmQ[f(ϰ(i"d*L*H @CR9!e_üobϯ,$ҏX'g&L,R10R?\'Fе ,$M]mjjI$WE&('(Z#*D?1, )@Gi!šZf֜9+Fgcԡy c(^;EPݿT($AYDĖa+YmFi#m˯IsB石x0!ʺZ1CG `_TШ/69yU( [?#̥%<nz1{'Aጫ?ph L٫PWFTomq'AY >@1yb]d/YsrN1g/7R ot ([9O嘑uj+k|$fl짧\(g ~wIX!dR68(#]vJ7lD!-Fyf@~z ~[y$q5׆8'1̺aLa ao]@m0fc3200,XJgp݁=g֥xZX:# 63K}6|aˣR"\K\O Dԭ*pWnRa4XyR~W\W&6ŧ=v%Ѹ{iNHshynK 18 a(R8ui$) ݆Pf^kst6@Jݒcl66LsGh;u[q4 1qպܝJgq;lEv -==.z$}UH!QW\82qja!Z#gGN0xLk{3ځn9Ky.$IJ\-u{|=.8[)w;WeFzd:QcÇ7*$$u)x"uSυK*ut53`6` oFk,6;+KT  2nu|Vۜ5VǑ$vW^frHtY0b%c(^`ԘTXRhh&CߴH^e4&EQp K Ӎd;um;'pkt33|v.~ӲvIbC.A@=49<ʼϡq 3?Vj$6Ykuw|MO=xs79tQNԇh en㨇ImTVq[B"d F_;78:lӚYP1szLmr=Lԝ#fE]ȬuOL 436ENA&~Py ێ/<W9msX]1r1yzi+p~xbxG̢CD~0}ZزSu|E_W˥ݙKd4jTt!ɼA4VQ:dCh!~W\ "~]CO \XGKt<豟тOƣ=OXs9*VYr$[JdoнUхuQDW#'(t4~q[m+ j KQ"+J᥺9~^3KXtfEn؆?N:E ҹ> |&.P,e/fpr6#B3!Tx"^єW5'i]%.b*yf`rr2E]St7/v:j AU5w #ol aP-D/걔*} f 2][9g-/$j~'Z?0\* O]al7`ӶNREmە'0 "DdS_[g6 [py6!SFRLN+Ÿ́AÚX8Ɔε-\ƬiŘLIG{o0j͆ "N,'xJ0~,d26o )G!If{M{B?R_OnE7OZT&2=w⃑]~yI/lZJTeD3_n+W  rByu)O XNa{i.{.u6gh|<?>ijE*qE89:ݟG- ݊*z6x7sLFCyc @Uƍo9`3vq!)D*8Yb oS1򪐇`&C(%Y ҇}ZIlkI-1 : ~}WKNDpa\2 lNck\g>{:q{,.R Qw<bcVyI&ϖC5J.=*=F7[3sD Ȏڡe}\]|N00z*Rӽzno1wWhfg8J)9qqNoه]_C72}*ꢞ@j*gϨ\>CA4{%OtCQyΙ-];F ٦P2Lͦ qv7hˑ4C|QK%%!=i'-MWCȫ3:L< vȹf04@Xl\24{$tBF g:ՔekIF*.ׇڔˬ? w)_zzUH,;|r%m?V3~IDn]١_؋U'c)R]ebuj֜2`dˈj)'E40F"c#w ,9/id->keo[L =zy!!_8K'C[B%~5#QV8tDATQI.o?]~ [rBG蟝ól)&l +ԡ$ג0DYSa {`ć;uRMї&ߣO)6Xx7M.r|ciox#ǮuЂQ[Zկv5/K!;jT0ҭc^(ip",p CfgxM-.n\;"=j~BWLl)v2g W%rIEߔndi;tfM+bhSt쎚9>wEǃW, ՉSbx綽Ls;'=0Xm^w(XPm]}M0Z;wȌO-ĂqOuRK"uN9RP{:"¼:a44Red$ ![*oB}UfK]s5.!D~L**a#'&{ZSwi@Y_Bߛ- k h9ϼu(|1+Oxw8PdMOFL&-єM)n;^9sf4w!xIt+9]^'IaJ=,\j#KzϐRt:_1ǯEW"JR# W(?|~~tvP5B^n$xu9 U99LˠnfďX-_Pmwl;C 꺑E_F/B؝Tcaz oSv3umV=DH+ÁjԋR]g[2!cūTXGH>G5IO{ %zU)xP^_1Su~'g g~\xƱJV`DOBiôsE54%14Dp@䨠`4op24Zȸa+AI\hyb Qɑ0 5S9Wk^Op/4;zD;|ӕ $' /_v# Iև`Y(݄e@:\&O3w;&IoT9NPìv:v0:wBRUCØ`FS5*:[% 4Ah.zȋK)@qsqHΌe> W8`FWWzR]y u!@QBjN]c^J{zV. l͔U4v+-`_[jϷf%n8/czzJ`V')9;<d: obN; sW3$c[`I&#ZoZa%{82+!CFsfѺ\d,:q @(]X+!}K(PNjrOxF:1jc#1v+:%ޕF ^:b~ آ5te 쳘a1TD֜GUHժWilLo^SDELLYMG9lc0ZZ3҉Qq0)͈H"JѧYtldHĻ\Vb.Gnmnv H?3NS-#5PUTXV.;(Dd5#J- i/jY2_ܥnva <_uLenڌtBiK8Lg-~cP0OR@YHF0*呌)Z < i8wRgRYgJ`mݰyϤ'voa ƣ;`!tCTdO:>eqJR@ձ,eU"/?2M¨閩W;&x X`?f…/w4zG˩اvީnEm8Us *CmA6zMIs4c5N"Vk#Ō_Ǡ^} U ŽTW8apӂ2E<9ΙEH6Q6h:W)Un:*UklJx-*G*i=T!R͏LE8`H:-+ʁч˘@& RuI;@c}WuGY1*>;":Xtm*:ԃ2)0w^W FfS1mn7tt!TZRAȜ L@Rsgh8 7~h2%qS16b/50Z2bSx~d\sg9kx;#c6CNS2N kM?- $nv8cچ">Xv-~q\u_zTl gq:PRsXVGAtv§X|w' ;y CIע;l9j%cX? &(d!?Sjͳְ> yd 9ꀏBdnxΣ=Ľ2SzɐiI:->HdG Ļ, &Yn!OcA P9[H <4[R)$ܳdW6jY/{+ Q~583avFbaðY (?o;$IYGNhL Vms#֛ڽz@xTYwi)I:01c4V0DaM;L$Ѱ=l傚T&p %pMXr) zyb)ܮ]vmO-JH Rqk[3ǮeJ"BػZCh7N5mJ^\;sDnnꖛTكnWנB6&cXT"ዷE+mZyĞ|)k;)vٺAȬՒYO}0dMHa]ňn7nUcϋ? (ͲUƷSɃ*ZO_ R zj ͻ{ΗhY`wrhVH}V36AEgqˮw%%x̓"`@Xo7d 9_tEH{j|{ٽI;ӑBSNY$N og.@]ږ.EJdW}-,nHntbpy9Íwk"MѤZ8z #q{u'˭Qn w"gD;QZ)0 u;!)?GM6' [_EFv&G_Tr i}rr}CZW퍠ٱ0>KwG\[@P`e}y},bFpNfW97Nt]ci+5AٱCKDU%)4Qu'fPo>pTo.`R},ptkD/aKVNN>AAJXJ.G| dtR!ivb̞|>zGV{y1w"4r<P2Vͷ3f r;?4& 'bn􀞸TA[(AR*pS3uXwJ5T7V'Ր9n*iEc!Rfq+}O5j@T>,]<2@=n'͉=B"YKwa{Öe<^ %xъ Z)3ʊ@6!Ǩ#+Ey&| IKi0]<JG#wIpDP+FEp_h֓`zt;qHK%.} {[؄)$φ՛@#qYOWp8h(tFД#:>j*St'SoVv - aZ1#08>@|+m]~6zDOKc|RJ! #qsRc+u(תf<O2-eí8U0TW|W(;&pVNI=wel6 Yͬ);^=^mΪAo2'HeTP S/9Prs;z)oeFy+B髩_*jIk(&!4#n|`cJٚ[`?zҳ& ߆ /ˬZdQd[ZoI!v gIߛ [XnE;c=Sm585݇un18ePJas*2;|{gzYU2L[I5s7[,߶W.3AY?5h)5ըeMUa/4S#wK삮L4T ljTAϠ tHpˣmTUEIg7@U)i4Zy"q~]ý1򩃐\x ^*S)ɫ'1/ ״@F=U(Š!U&w-՜' `;}Bg}'?i/˰=X6xą:wkwޝ&_4bX+ +uu{Z1+mǽSAI5e@pޗ4PZf3w=!{?VUA渶 *gt/rD!OPwƋhe`9Oħ`Z`|TCXpKcs䰖u1+e*Bp,^peͳOI׮b0fĂH.[)kj0ݗwdMމ#4.bw[yў)ަ`#½C3aB TBfYG-^]?2R*֐,Zxn_G랜=sQ_0cF)RqOsɺК y4 $SyF%ȁ-Sr[d0L"rάcӛ~_00 X\ԱKqZE mh’j94Sʋ#ʣl#'a*&JVynTрH'3Y4DY#5m.ަPH34C{F%z@^4nt(['0-j4舑3 @p .Bo? Z "UAy:T]VY-z; ;^H%k 2tʾO2zTmd0MFhX$ vRa`(#~>G M2FT>g6 s3y[a,Db=/R 2Ԭ܈1+{Ç&cŀrT_jggx&$Ro!~Zʓ%Mk!KJ@[>^+7n0^ aQ([J;@ˎhXJjplw1ZXQ˾h%rvN~ꟼ&Io59\#'9 J4x> 3eZSDlq, `Ә{ǩ"8B1(c/}c)ZLz)AFnj敲OMS^% :]o [;-7G+2,fY8DWe;*KPڱqo(uJۛ=ȩHidZj!2FN RE0[b.i'=>3Khsyb*ϔE%b8:˜Ijo fzqT@}z2Bigz@a"Fp8#$Z\dakg:>!%.7`Oa$ۨfmN,)ijG7}kg$^PFol [ }ا.ƨSDVw`v P)uQ^c8[&+4o#`E*6{#J.๒-pN=s({T=xnЊ4WY;H%\O"p:AO#Wd?YywաFprtq#TouWRmGɹLx$_M7N"fP(A .fF?fPg ʮ _ '9kۇqt.sF!0Jq(Οيs̘@ǀU4"Ӭ-ˬ 3^YM„e&F]5`Ŏ@aB"實1O`0}g| u47^ga+ֲsQ\ )`LzNe틃 |ZY }=i;3s-MqEl@6WڤD(݊ WIj$9!Ihw^:h}bq4ܽ{`v4/6rkI3!g% ŸhJCA'[yj' ޕ)Rm,q߿z1o` _a4|M-8"讱+.hiE֟W-yc Ф`]f/d>dU?"(IjGoVLV5a-ٖn@i&':(7'p -}`Ъ1ZI&SIij瀾gxVC*ؑ7a(iu.hKMh ! 13`U0YXeʭ)UY'r1vx%oG<0iB`l{d\Sgn y$'~!6ٓK(Zp׃.{!E̝UuJ%]ۋl'P^<^wڻrK@_&9%m.vݥ;׻FT?/(B{C@"{<t)Sj(Uʹn}+7GriEJXi)ǚ+Z\{KG"QjݠY,+Γ+Z|ʜ)8'&ohhbJ.(J^3:"-[/6(%+뱛$XČM#1|s:A]!Ax(mLƤLc}ŵcEe994{g=^/ R<DuP 0)/8Yԏ_zhHXob80bp`yhi0M%āc`M5Iz.SC1lm}b5%*AUI1bNbx;c{n4 L,pr' tt]fK>[):~nNz璋w3 Fn)窇 "48\`}$54~qDD>j̋Bj *9!EZω7VG}p89*)&f?8? rP&Lr|q|B+\_XS!l$w”Any^ SeWQ:R87X gjH*t4f國'# tֹNp$*L\8 SѪg=a(EK45zTho95ħERc#grM̯'wL̃bQ6C:CQ Ĥ3QpR53ae#-Ut*G*OԭȘLj#΃ J܋j nG.0ޡ IϚo5}NA9ivYS3a`JctcS4Eל;SF;k)=1TWsd_Tp"Y BPJ {Y{/|2Tc{`E}O{R!}Z#2866^`˲}7!އa[nrpؾep6ERկrDL.}m( }$ 툒|WO.mp1CiẂ0>yF ͗EG.]N`)NE{^"c< 뀞w]M2;&@hOf;5a yi*UWD> 1FA^i lO[^zK`:Eu<  .`=8$/>I\AQq<cլHbD`Wng i3(`clZƷyvCb*m <%Qc- &t ]KSl&݂Nf 6`az;vͽ;ͿC 0 GFKpaD-p'\˨*١ʚD]E+ JMCބHaf_^u}v DS:;pnVH+ cu-7ّ$/hĺ6Z׍*9M,. lئչRG" ~`hysj](:M1 oEk%:oД1~t8|x UrX|ڂ| kMt 'Xl}j%~ܨ""ZAٝ&H'Q%D|wr)Jox܀8uQI_J릷Hh~'M>R2~d,T&8-ײk *e.!w9#9`MEWyKp =[LcZ-*þ'w4K MgWB䩼~ll>zmsԞFe+>6۔#Lh5$p21iwJ. hb^~wCpv`ʧР2}\b+Į>ZeQ>r;1[øl 0UJ!yɫ5"vA<-"mW9_}#zmwJq{[/['WB&Jt980y>vVGc*C䄩V >Zq*+*  bmD [ܝjB^zOb]uE[x.ݔu7[㪌'J1֎6P8< 3lOapvԤRّk3&V/J;tӐ'}Ee3HNd}۷#\A7Al.Iv* i0, 9_]ܩ fCKl*hAcPriydYtć6RI%zP) Hm,]ΤC5]9"HZk6^VW*7мHIhV^OH2S:RQT ^Df]Qed%zU 郼HӤ_趠 v=p41Tj:(♨No fɊUaeQV̟(ˑܪ[z9a "4w 6 : y1g+3'(dGX;؁)ӭ8(1.cGNijuMH6xvfEMtAhĠ[9s3zv0 OY\5XʺJߌ_ѱ괨Jg8_klh[Iqi>ju3}wۈ&;VHi3D:4S6}p-"ds?CYǯԵ0[2g-."%6J1TYRWK+\bIݗ5hI49~؇w j7p :N"=mno7XJ'^b3G b2p%]!EA#!Oo]e؅Ux^XٝRʜ3$f~%yo:~YUg.L.YܻAs>!JA>fdd#儼)3_WRx2~p }hVNpM$p>x7W]C𤈚(7\0P2"%1۠x}ps`%{>eǯl_4{3Mʦ+7kߴ$v$ݜ܌Vu c`q+xDaѮ $Ӌ]u25Gzhi`j/я8%*WóHXi-3ۙ1N7z1?%gTmݷ8w /%E@Cn !4*fh>8&&YgcQpT;p[؉y^렑E˂gl"Y2^?\;-,pWM{/8X0`WpM~I=BDk[wZ?P0^Ir!OF_ ;ÿ,RxȄ"(mv!J`#6baj/VooVlFgaM=kFIƶ{XsWt)9Lj V{9 ȇ0q(d_oo,е#9|%Stׇ3POREFΊ3 e (/B ' 6 4_:}F 1A㛅>S%+8􎘦 gfM_= w5ܬ{5# UŐB蠊6"^IwO;[~@$q@RHM;RЌ!5ߥ/EU`+>[tԛEY27>4Lg?!(ϩ?! 7?'Hw~6;Y3MRGYp+pn.y|m V¾q\uK<(.Q sYŝ_ukTc3_veM4XxsD~\b #@fvTUuT2眧)so;-(z/ RafJX1ʚ*{G-f,yk/˽jʹ`ab1[F1zdBug#[rcqWR䄑>YMD <#Я6DF60v&-]T((л6Xv] wݙ8H&݄;O"6? YR58l#? vRZkOZ>(TwrSo s8?hհsiGͿ];W.CR'fҒCYa#(j%"SZQFs`s0O(}}O xeݩgCxSwbi:dFޝZ|WÔyg9E8rU?:1ʠȕ`X[=yz' 7'E$! X0{kXu:Lr\tPburXu~^31Tq3b uiU?UU酐\dBq*" mƴWJM'ٴ0gXr#zk)~S@5"uFX瓁M˼D gPO:`KŌ4"{8Xn̓=$4IcߠM{ 6C}g%5|]d˱]l+sؕp \nаWj1Ma;y])CM yalk◌]$W`%Rfy˪6Z=練$\ bJFJMKnC~H&Sl'3#ufZ4qn Ӗey4 R,nhu7o`[.7zĽŒ)% ۇJn!:6!gkaQ߸>@}$Rol<5a prX0,.%M[FJѴrއ,@tVG][ Q@5QOB^ JO/anm\R^YX"nq~Bab(JIv}}eQW` ĨLB;[22vJ'^th! -ԛ,ᐿuicNtJl6t}ټ#y= &yp|vY)jgɋ)55y*pA"?X];1!ont_g=z|yE|胈FsCEVdYj 1"Z2&o>k%-9okf>?xn`b qCg:5%ȳkݍҷf >ւWGʴpr9cktcׄ^y{طLփ,M:a|Mk$m;?[q(Sk= SfCHNʉ n~@hsm\5..g(r>+Ame KZQfGax3M0k`v#ANz\+|O޹ߺ;pd}g3aa5Z\c(kWY_AO/{BrjHtِu%;`ifIlar^clUӠ D.y<ݰNJ\|<Nﲙk+GD@r>́} ?ڬO@'3ͮ{GMiZh^NWI,SfsUJ#3ZO{!&{x4#?} \ϡԡۧw(G8Ma|P\(IL֨w\6êI?GLjz1uk`-xEA#.z1-NXL@(1d`Hⓥ$ROh^?V@-LE^Nڒ;ٮeܢ"!j|[Ę w~&9WJ_BnBj$)'H?39 egQ1Nn B d*5alXig)$nj&0+$x@}rSiunjD1WI߻qLZP҇ ,դo61w 2# QW!Q6L@-15:o"!'F$J3)];0Hԫ&8 glMLV`Ľkoh[Z:xC&>.͖OokʃMKȌQ3cHۇL*߳(ԕiQV#gLJ]BJŽ{%@v ex *Q]1!<,AXRs_:J IQ "0ۑfL9tVSF5W\ QE.t )aSu(Cp}R9%$ʽ,r&A]w[]H/z%wm6n8ͦP7^"fO+%r @x_m野9D[[n}oEo21"R$w(e\E̜,C?\0fhF-e5<MPN&X}wjǒ[kъ9֨E5zh-S,8 NTFo*S"QEU:%Pl|޵Hϓ/c/@5`̮9@nj%Aw}(c_'TэdgCѓ 8Nf|j AP__CkCe!eDQG_K̋zR+6|/H]No}Ɖiotqqi1ͬ)}rsonutSHqzC~M0N;+L}7%m~4}&<`4+.Wlfk#{ \з:αE0('ӡ ULM_mTà)C&*Pb|E I2ξeʞ\+ Uk9C);_ _kMu!PYervibPP^f5IU;>b\f #iYwdtl^/H#2aC3D{$E $6\q$%~i^|)] 6c;Bܝnl`[:s$ j%;ӖFCҴ-`m `2"/]= 9C$WrS TXew\5QoNzՎ\ރs$MjΤ([6z][lP: g[[*lҘMgS#c2kxh!$;=0*ӿ=?Q= :BEEПܓK g<|,-9V>RP[OĂ]A]93Aۼ"#0|9^Vo*QjzOmTDp7}L5 /ЃfF8<;"HvPR\M@kfGLvӜ F_'_iI^VFn5Ʀ s@‰6϶vNb4>-h%{/oZZՔ.*ȟhM锵h5 [$T1l6f~L*FٟCJ/YORl$ Uj0bH&. |GwjcS˕83M,zb*n9v(/v,F5ڛTk G;B}' m%ݮ6uQ-gѼSYެ] _twRģR_v̆:}t+Ev!IqlзY%``P3$;‰e+Z<ލOܿ[(ycUWi8z"g)Z\sr!Q+Ngn[*v%Lf Y(eSm:]+^7QETn76Aȧl5@؀bщ>wMcU0'vrׯj ÕilkjU#ESHj 83i&s-u~XiPSӵY(pC/Qcw͆`c,?\hER2A%I.YӴA< /fhHl;zGN sӼ֭D("J0 Jxp8)4 [!h fkS&mO{;2,B;b>@h[{IJ֕o S8db]9NTy6.؁Qy^oBl*w~RGA[ɶY9tRҐ(4)Y咙v7ϴ'b8$LTJQxbcC;x`J:D V݊W&Rš?PLqygoɌ`v)64 Ѱr,YLo0 `p@T,pX FĸggyCJd@]Tm&[tD"=?]دVagL||f'2˸l%+[TCn^MɁ\ԗ`hmd_d&Qj_SSEHp)OX{&a'1(? -2G#ݟ}]%UGECB3K`Ӟ@Dyerޙ54·~62;ؾ9nBeBK+]N6eBD5ĂTx3 %9Agfo9Q-wynR(@5ihο( YNNu6r𝓜Lh[T|L;aMr \z2U'ME5< 8* u5+IK"XiyFKzqUsEc?J{ZkF1O]| ckFC'&20Tg$#V[V @!Y5sƆmDQb*^bWF2/|pS]NcAAlXPPF*1I $6҅mֽ8_vc-QE+"I]KF<Ivw)2LiZyv!4I^, &eSXx AaX;YuO؁nhM*k:rT9aHq;Bzi3S]1Z<_k:ʴ,^Idλ"};h\e2 #6#_*U*07"R3/sfSyxtI쌬AO*֪=g>,P$6). Px8h6YH=*M$rLpv뫒ݚ認)4ca9ٙ#P[D ׷grROxVk0*2fr=A*|cSكjM7:% o+uK"L0, $).P'(zމ YT]3M' vHVNVS[D{f|u93M_؍&84i׷`ʱq-h)DaDKys"a7nqPi/o9 "P1MjǨCqp6_q 7!x̲ (Μ:|bG(tmC} }lk(agj5װN`ۮ훿+DβixɂD}={|Y/( WOwL2Яd]qxq_?/_77Frzr=\">$bOQ-"?ޒτ矊e´92//To*Vtq0~I-i/iaxFިEV5_TVsaOUs<{rCY5%.AUe ڌn Ff 'i>'sBvėH|4x]>1s4G W0,H``K ?^jD}M~庨1T;+:4\ ^j')^?M p#7'0 -'}5 s*U|kdxc[xGYUhenq`|Rj@ ݣËnJ,,SZ6Ɣ77Cl# {&;F0\Ib"غ[CTjoklk7tE (V YÊ}cwBI4 HmeI&l˙Pl{ӄu #`@pV!T}!ɖ߼ɞ!ł~щ8 *̃퍢N2 Kň{P*yQVzL` #$O4$"hEAR^ 2 epSe%]]ՓjI, c ()7-fYOg!IjG,pC |eoQRИ!7 3+Cm|jC%S6ּ;A8I7/eC 1M"/BZ>SA(+ھ,׏ϥQ\LU_^ L(o0 Ps?&/ "21UDLFF1Reњk8BM!T8U1ﲉ؝V{xMp U5`ApJ,̿SJq>g9.S߬>!m־0ͅ ~'*C+z"ŰwJt.}$a"xO1BRUz((P“.mԻ@I3V*~V?al){H l7H^ΫlXkMRQu'GS fG|N"B%@mgϩ4~iT ONwMVkPi;1 ݓBʷIr 6e_Sl,YY&+-kmf0 ^xO1ð;94;1a<[|&V OFbiY;C reY3+8pLfڰSJSĶ気bމ\sI.j:m5)[ޭxRt]2 YcD~ ! %BE{rQd0b%ȶԳl(8i+\KLS#̅lu]=۽NHxdnC+2W/wc8rCm jzAy '(gF4D-ƫx}Flٚ$NÞ[alBl:*9 /EݜEH5 gJ]V:&]pz 㳀|q`Yf pҹ#+99eHɝjM\^86H]`ӃęN5eAG0pQڒDǷ=طFS[o'!v:֗o-c`f&8 q&X).90ض٧cvY%vjGarl%&X (%K{|޴qe. d:QUM 7^-c9iöځ='%ʄEn:*q"@ ,sYOv5X 0fC(,HiXŇS9+KεG~i{ y+83h{1H:]AmK~+VH1k'G)M8׵| pEM|%l*H@TMdN>ZqQ쓁)L:u^N|$Hsރ8BݿH d:O#U/P[9sP]e>kxj{XB(xS;6 ıqxpwl}M|ara-O:;4Jnp2; Eb`'%? vm:͸P2ʒ],dM:a*C졉LSRrI]o˃*j%n:hB0xxx=y Qih wԜ㐚h+7\pCpKT$1e*eJ^9)9/nƥ$hLrRE74P 6Gyӳ:ڽ=݈#/E(yШ_Bt[c]غV!)Qd(*/zDK^5C$g-FR~TY fei RۈEA([\j~)c,D;)i؉nvV)C;jCo/FG߆nB)¨=hGo)]7+-̬4!NmY,9/d1MӵEzI1MG`yTv4ެyV**(gf@s[eoA`隅,lwΛ^яqm;SV$^ i{g!ƲŔ9~j!:=I/iBa]1wb!E*y];$ 'Ξn yX%ي`lϵm7߀bVeuU``^$;F`s Z-8M:9t4&zp1t{ʙN=yG31}"<@j9˅ S1 Z 㷩e:B#zMQF6`Lr;N? #_̀$Vx(a,@ MXg(N8`yО)5HB»`=eAm[!T.+- 2 b8\I2Y0n񷘑U i@pU7Qn-GI^]m)VQ4&flե!;[ *lU~mn)|$LܽnZg:V{?b=Yxð{&!X2]΂7|}~ .̯=ꄂ'Z$ib@J8$~m,"U*gK*C{l. 佄L|]Ip2 5*ˁsQJ+ʭck! ko="Iѿ&:I?-?w Zny_ Z-E:vJnǍR)P(jdUe(2@(L*h.&(N n^yVIyڣ)=̘I馉NDsz8d]ʩhcl540Wqeh:L,^^agމ.}t޿;!aBE A ǾO>{#{*AWug}& Nf@5BBпD-cT<:vnTC X\cU^0DlU !܋w'nh%kBjUId*tDqBD딳,sWx*6 n.w͖Kqٚ,owҢblWun6x j1;SQm2/*27 ي ӎ5oC t5 B6kX}&08kwjکQ?[{T {X9?ۡӋR8jխP(TW!*WC҅|c]BwȌV5o_>f(|>\Q[~W, ;tyl2FMNFBjtɡ biLfe*WK'N'dcm~ꎉ1&._#r$0eKb)Mٶ2G'> RS9^@PD7InURu5"ykD̵"Afoc.Ff5@@TO%R)p# WvQ ,ZYԌˡ \[Q0`4߈;YCV5??ѿE:M,[7&u WqM=S j8,,忨3v=1@ p pD''?&HdCȌQ+([-Y`2T|quK0ʷxBg(3fł9+ߊ̻:$_{ys(3` e Erp/t,LwUxtvwkcN{QdL̙m^pN[E6u@e(i#k==@F=xLN `\WBh&Z&MIz =]6/# HWl;H1WBtgj cWV ;M+wO":$9 ^pڑRN<;^ 6ZR(+Qܜ8IrY9paĤ&ĭGδJtkE2]<1+j/^)щ,஼ ]/-3f13wղ =N\T>O{bw8J"exX>j M(ٸ)_Vjee>3q+ X?97"2|ZW=Z `󷴦qEǔt9N,~wop'NDSoJE3ܴxxJDD&9 SWk'%ऱBrVyqk-ɞ`e<񶁟UU V=Q*J½]82 Yߥ{Tn )!CH# g bw#9G>1q$$M]0ݎpBEFԇR5r$'~5%$4w֔>wA,h)lMx<ۚ=9bPծJ^y fz1o≙LD-e*=KbPhe ![o] 5ϤN,YрL*|n|So nrwr6uݩtN<ScU')0gRR0$&~qW 078-UZq>{!4Ôzjqi2ז=f#X ?oET2L;v*ڒ VXOzŮ8SF[3 r+`Ñb$<gTU=E(:.{[E]wg3Eל96dj壿 4P yԇj'[㿉+]\paZR}n?uIk5g!e1 q?.-*qI#n3o? =+֧M.LTsuZcǡ8)QH>*+ ` ˝Zy\#iq-y <6~3(BŃg̉I)#{!W!H,@c\N~_ CmxCqGn]tp%T N ocKx43CC ݸpRڨ V{K^GnK չ$tWb-]Hu.5\ ogƳ0@ـvwD #knlXȊ6ܑ[@qNeLp+nݙ 2LE\(M8`ux,9 ʮv6( n߷X"Mޚ[[#@qqB1.eE s~eKNipj;C2YZj/"-cz᪈x6BXL,36Mҁʉ lb~.o,thnCFb1._2O&WY՟iRܭ>l]>DS(T "Wp4u*W#4yusiilFQ>BePgQ vł)^`{ h]vgb N>Ҥ fRJ"a5Gw+TH;IdMHDS*+(#UFP KxX` 1AuЉoj4HfL3eB$dmª"宰Q+ϰkƔgT!?5;L<.{SQuㄦ>ڐRq'_]&$. @_ "<<N1[<D:ԎHckC!09fkqhg:5_SijWT/)8 ;%.h =0&AK n2je-m̔,[ ۺ%oD2VC`r;{ʼ` gRf4hR 8/DLOݴjYğ# mfq?jz,K;U9G\)]w0 d[t,t~Rǰ2/)E#CQ!uT.bhSHhv]'[5d펧<rcKƇl ;0)e,+@eflC([Ġo޽ɞ$ZzvHncȉ7oX(M%:yID|Vf 7N7yGvғ(8IP!ERI$}qUs䴩ASm㤷u*N};- pr@L惣aYI 7ם;G+^IOErP1yv+W޹ }-g$T}"jzFQMQRROX:Hhyo=bΫw8q_w[p toЕZ͖H%TUI %ZP愆T(|F@5|sK'0 pޑ}!|ja WiQ+PH38@VԵzcc/%dbH%ֳ!ηS~ukڗ:O%\`,iF.%CŬ.mzȖb)d+;l UfeO6bw0s_sS4yPC'Ik:[ ˫Z/M [~ժ; DJ3V2PBnȻ~=&K5hh~zE5r*xA2hտ<>J✷RLwue{35xu#vcjfzR;.׫RW}.ҸIIEノs5f_#5!Dݢꟁ[tV&B@h2pS"cH3)n j5׮qG1\ӶT0 :`FrFL(Vâs[İ-$(v́o N9٥`Bx:Şn݌*,ro mlb,[b:DkXU]C2S{O`Ԕx8 :?$%?--}pR5}?|&󺶒0Dcx"(磧rV88l4O]sZ7u|(0mjhԋ&u}F_HC5=M\5Rg.??-c䨟u1rxyn0)^㚓y_cBw/A=:CZ^.t5?oBs$u*o#/^!ߊiP?u| / ?n:8'ӯL""AΛ|7t(&2RTq 1 7RQy1X;BؑTբr6:%]KD{뗞QY 50`[uC'h_/AeOYywśon~Xy%{;=9 :RV  ?sgc` 4ȪYZ:Jb?66C a>*:fԢyTrW" Ö 7]Z@Iuga1cE+ҷ Ÿ8PtKiGDpV惇2&$ Σ}jCr[Ri0pr]1eVς,a3urͱƕ@᧰ <]X?#ۨ$_ggGj߄U 'ҷ4p n5>Re_DRs[Vpۃ|‰Ec;, ƣ49~džQ4YGG>Pc(˟N-Jx?(vE[`D 1z>@೵`?~dg50fxLED2pƊ+ CjlH'x YN {|g |:R$wYFן7(Adb%"@l 'ՍdYy/@p;lF-xۄ=?$FMLO LÖSi^΋fl/sƆlT|/Iݒ֬vt-Eq~' 97z&/YAH7X ȹ}#o?3Xl0 ^t*np\>mMɧ$O}D WB!QeW1N0"/.]8ˀjR=j) )pP6b䞆tR58}TV^.h<9Hw6_oQ%\_R?QOv{Y@H(11c MGgb*T1ګ;^x;ux;ꐪsM.[HX!΀p_Rdƹ T8ͱ22Hx9E`- 1DB0U(% Fwۯ z$g\68eI? !nC?a̿wل+HAVpDjĀ@-]5#AG'6I>C_[m%ڵ2֤yԆ@DrŹYv̂&^6,LI՝5ep!G$jt6 ]x1`&~K1moH,q 4XT.l2Ƒ3NiD*>ܒR\I4uyQawOעυ/WbKb#lF#~ B 3 v* ڑʥ";;ͥt$K#ԯ?Cc5\m~P4QBC;NYm0riRmY @#I@tO6R4iM ܟGSt☈Dh-qbFkt&!>h]y ]Sau<F`n;JBzUlzVaB0h+dGJT~L5&?((1:ş%{A}C  8hFB)x#jȖ_&x6{EQΥ G1|9-Q݁iN8 E]&l8^Ph,ř-fed7ifiTwoq V2Jw bJx_c(Q15*U/<[8Uo"7?v N*ߠ}'DP_f:\-]Mc>H:Ǖ3t$ҴU} b|OjuƅŘ[WԱ!dWNtQjgl5y}H'$ZT#D! N3 k_1  KzM)R.*H7Q=za3yqR zD(>؆.^dž{-Fh"%FgQ}plXirWoPҪ@ Lis1]=^1M&JfdqJRV Ti\xgl/ءV >E.GYN0m3QdȚ| uR!bLv{Q4E.aD'ᏸ*.%y_RT` },GZTOi5IB_Iu?rjgG*.Vd=vQDlD9Tiu5B-<`+ }S-ʎNpkGu~@K/]f( {?;sT04'Kf]~ުQO ZԁOtw`ufϭ!7x'Xq):?KR 0 AWC+G;2s^lv%-M\.!3P_sM}Z]y*Yea=K,L4,^rݓ1t/F#OL-H !4"ָ+'KM:afZ@Rξq~CF4[T:2:;|A5P`2wG0_C(3dk5)[mpYL+MT2,+Hx@f*(k/(8`v{6,<< d$a ||\j#:̕4fV#LNIcbsA:ҕv okKd$)?טȰwLo}`5.Wy%1$`!'k.$aV)!J~RZQR< g݈A"=HW_͘n3w0 )anӰ9gTgy7`ڊ9uSd-{&_[E.;IpKOK駦R= 6?r _,{ZQ]("R`-z,"GѣlI=NDFҡ%$3~հ@bcժny~95DFpK7IMKP 2O~h(35%*jaڂyG8xt@ 7XsGʿ\=ka ^fN?3"F8P lvyYIۼ a3&"Q#݊88e/wKUf{kO%R73\Bf];ID;R٢7r*!q 1VqYQ%˪wKnPyϜf0o" iDۜ-"` !1ЎT R2Irr|;NkbQ7>I͇3e\pdvt>`#bA0Eh[ ==ܠMsS[fZwjZN6]M^5ëgSgw D%%A~^*ڽz&WL0Ej`RMi<*fr%poR`ߌ]8 ƣ9/dMZ{H\2;~o87@h6{a>[& O(WB&5tkqȑqꬶ`i"P)ULRPwH0v4E0k=(Sj1@J+[ E׻X[0ߏnj܅ֻQTܑ[y*>C(M0xVsyJD.kZf'vYS2wu,r8߲mac|M?&Z@Jtہտm6Uĕƽ&8m[JAzn@4tVV- liuJ[33Lf,yxwUL0p;%h) U{ɖiQ@pGNA(s,ky(R}B_X+B9m?ҩ _Bs%2NM)Dİu !eHХk{7EH1?0=.߮=í1{>_oƉ0:-^/ l`!'b$EԈLgE}(i'O'.u1lg*B0ĵkUڄ"lM%gh]D,yٸr͓4ڄ}bbB$9%Ó򫇣6<`JI9T'43OIqh iֳ2 .Q 5%1R|d5i-(Q+-E#|TD{ 2 howol <-kbz ?r9 Q칝[_QM',|e(#KvLSWϺɢ=:je>*X$7XΨ;TLO{X{Q4lw $yx0=0{3#b<!:q`$G6W}td~m=WI U֢KR1iCB/¹9W/`z^NfׇCVo @t頩䦰9 0t!($(A:O.obMt)LU::;*2iRFks0)y-|,H̏mKb}0C;fbg yrmbK5t/I\LmӋ'R[-1v)ϨOxLqayM:rc9g$492?juND=%t(-K,D2L>5bd !:bWԉ["2hs;nz8KA[/ BE[XuV˯\]*FA7zo(m^lfzn|oS\u.fZSEK@z}i&:K߁L |Q}Z}̶ q&˳ !q$|n#)/)yA/_tXJ5>}J *P w|USANVr%BgYќ@E„bs2_h DcxWJꄻ˨!+W-#xFQתK rU/w"GĊw6.\י2cѢO?=x1fSy:,Ώ~EHO{5 Dmf @ x40󇬴~a}(muְ{^eK1xk=RQ %*gɝiFh o"M2:!9VMQHpRIJv 0˿ḚIj?eyz]HS_+z'R<Ė#|I(Vd93l^5y`awEX־t 8שBE_Et.A)D0}GI:&Jk*Mò/ZU;3l(. `q}>UoY,Շ}hZ|fw*Eo1gN<|`% N뼏P =$Fct:Zv IIח@bw>p]-7uסCr7Rܟ1+*4AŒBOۦBԻI~IV@0Z:XdKJ0!ДEi:h!xҼ#c~"lZ@41(7L6n4yxI;0 hjNs3~D.BYpbc$YJ`i{:`ĉ {PDrTP岗zcx uR1Of+{jR=f趜Ш٬g֬te[jSa{r7T6M>-e&M]CV0r9u^a֛m"1E5N{tD #1;\nGPq$*.sq̏e5~:Wt\ES(RRlv̪A^-Cþnɤ'(rxOPnir? N'-Y1;T% ڸf}I$aA5O R>38DQ6 : 6U{ʌW \hW&6Qhvl嗾Cnr_/  ?Exešϑfϣ'd9u_i2!>|w$[-gyMl"zeGL Pp*\3ǀ”JZ݋NI`1G H:Y6\J}MĤH3T>^NLDgGQ"S7Rj@4wP/_zX8H LJ <*v o4,5%V(gHX7#XW-Rq7xcYi3RA"kP\[s Z”= G6_i'E&9QLڏ=I"&MG\C?V!p$-ٕjtv,SYOzqv^%DU&Z 2NFn(q;P}CY7-|]bFNFlL;pWV2VmHY*+) xat"tÒk a`%I+*r1E>{GV tN ~0~ O/ԏq rMDKX zɗn4_W!2zk,HifV}g]'t{aFt7*MD&<*qRfGmPH52K,ə?07O[ ʠf+ KXaWLn\:muRt*)AǟdƟ} ښ-#j^xbD$hEi1hG8W8Ű'1T\q!׷ŝKTQjo@m4A"JyRZs ~-cbxfz|4C]3O)@^1FKqT tf#Kxk4`V r$EKJi,5҄\Q- Q Em%I\zm QvÓ6ifd])eqQ#|)g".ouĿF]5}K|q?E w PjV@<5Z>>1h#Agr C٩\ʚ2_VZJ5;*j8@ p%c7OSO̐]FD[#]ǫzt|p;-j _3D۞%Oj:fK1,(3ܽ sҋ@BɦVoP^ ['܃4;6X2h|5t,]SJ,GI9{aIdT@8~l*+.+ Ś;8tOeN_Kej:4:|4`q*L7m}>J rN*}#k`}'ۇK_`c(?`^ M[Wϵ#j,|AN2giiw)=;iQwǁ55v曐8l>Bҝ 쏧a%Ҹ?!|\_W]p| ^A#{515$,+Z#W!2%=3O L'xV+_%our{0ۘLPYzLCDgʂ<&*(6y_Kw6>{.ev?bZ3.^r޶%-*XRe4' NI1&AդO9AZ`/gz`49B_9o(udlblrӃ {<5۔ BjϑO<[#>"QWq+jK/ b!>9V뫦$>_YX !W2HN|#ñv+|;Jo'e`ӭ|hϴ'8\B}-. ۍ LsbTUA=0^sN"yhR^seG" > |Xs;yiA$Hd+j$Ξϐ8K 5+52>rmY0&:|#i,ǑF>tZ/qoS)vsGVɟi6nXʢ\E'8@(&`{\43!C}"@(2Ҽ_xz&HbD\oȎ݃%dz^ׂkV{4'̾ZӤ;IGHtԄLU-#K~uU7#xO(d6x0D'/)Z{f"HdKʱ}FIqn]aDKBTR}xR[W\QXFYк`r"Jn\t.1gF'GHHxkǵTpål@C+gcM|#WDm^qq(ϩsH&Mn"WnjǼTaPkª>Hf7}wE,Ʋ_XpO%5?+MG(#]kz).ìqŴȃ>j1WܸVĦ m)jAj]z;׍N[6xU0~?׶6+z~<+UT5#O0O} 2kKL$MH" ʁfW&hi.cYdJrv< AcʊY+>\i&̤ ciD܁PŀA9{J@b)U zN6{mpMic t?.G hv<'0{OF)kC[\5rj4 HמpArQ@vd(A(L}NDzuv#B%Y*3zŦb\څ ["{ Z3C&s5 Bzw&erED,?r P(w,/Xc.xKFZ'X`'Pp/Uډ~9ed&Sbb\v_خ XKwaFS-YgZaҞ.ǎ6bv)HuE$DִHq5)NVu[؟)TC˰U]ZxrNsR3xl?l+oX['8@a ťzx9jnXLqKjO)tpdGhJ$-U\RK蒯Sf ϱ`i?b(zD|NuӤe1exႯ4/s?E%.)X8k]majR>}{װUk2xE3XPGA_k3~r ÌShW889YִYuD%˕1O)g eٔq' ;3BJcp:CQ)wk@̇+,5ni^[B8fN34b=|)bRGϙS$0]#/ȳkgT]0?9nj٨%9UEl*@e+&R7DvbU. 0 Wy7n͞FNTP`w];,l"-'gI˙E?zLv_h A8`N 5_  ٕw#y{3,*Yk%y*_,n@`Uj"B$ĉ HU}m&38#'ho/`{`B>kʿ2$/BB25DML?++ nɉ_?Ӈi!?{~n&&uk&]ekX X 0/ x U%H~Q^G~Luiw*䍧,N-27?R[$BOQl~l;%5oƂ^)娷 9.bWZT9\=gR1tc 1ZFI[ƽ*O (8^σ(,cZ"FcNLt}f*Ja=]\vaD"ZhxٯjCE`p5%UE0ʜi BgDr #P`98C# `]c8dXyǔT2 .k=3ab0F>U R.[@ҒNy$S`|v߲Ne"5Q/sP1|ܻ="F.t)ҞNQ̴g cݾ?|I2I5(B,.0vYboƯĽJzKVpb1(DW<Kfa=IBU:ߦFAeZO^Pbm}/6i)r4ʮHG4a3\c?}W[9'9=QF<3&EI[Ff= Ny{蝎.*Eaׁ5b9\9':#$7ڲD)_j T̈cF Qq4?174n3Yǒ`'NDXLR]o̚T`@{u<W$s{ E/,uV6=wM(yqӹnv1Xu:;v+*bʼ>΢??l؇mn u#E M]KE]х8 ܻN@  ;թķ0Xjyzyr~VҗY"ey!УK79s&ceHD0e/xCԀgh ~M{~>7C8+=zN s`휗]c.mIT8 d&MZ9*[d|R0M']ODS]mʼ#AX|`pAD1Dx(4_Yt(Z՛Lٵ }BdڵƪRMɕ00s]PSix6bpKsKe0BLx"1o.,ʦߐSgka9NAR;-z$ڽn5hW=DZ@Q%0,$f5" Ͱc[uEC\%%ìC]uaܟ2pᗦ}NYV(瑱)If_ʾFۙMk-TƛYC6n[hs=翠o£ҠCR[p+y˱ފk=Ё"ج z0})Fd= !ck ",sy֋fC8G{tdmf2SNI0k.4-"uq325/pϠ#5xq4QrV5+ b+&Ed|H"ݯB/[E?D]kԈ^y,'|ӍEJ7qXvU~TtH/2]\j*K_le.Z-M-oG-~(_UuOWz(e41k) "N#xW*h$vscw9m{6\m=!zaF|FYJA y¯ӽ_)!M} Ui&ɶ h;[gk/A=mQw|^_P4hTEHNPl|Gv)L2^s;vo#tI^AgRهJ ,z%=z;-PQ.LPQB@{SO:Byb%=ˍ}P7'`w\L8.‚ r 3'oJz^t{%GnFSdWBQO1' *c 1-@{<-)3/zq_cV&olPt3h)?<;KV-CG5 G^x^x@̐#*p³ΩXG!}u3icZ0B9GC3FY(N,SioMT- Q;AWNz,j0uZu5F14/R7S]Y z"&W (Zn=;OTU"^wƶ"Ճ8tXJ e艻z@f,5q 5Ƕ$r4d2ۄ(E~>< !; <ޅ6F-%S,R@=WIr.-Fqq3R9yO,-9zxmΕن D {^^l"7N+e{r]\IInfrhm&,Yu;:݈ՈU6E/tU(pԲ|+$`R7!1)DuxиnUݗQE7]y".dI.E⏅q@wPe=եvǪkC/ʢW5GI?n߻T/kTИIN\P3wĘÑKy l4FCQWԬ\)K"TҀ I'%2t± GAsQ[=cJmiD>j49g ZU{w*nAՈK=JX'*3I ZHuYf2AlKCME좝]?/\9o cĉ4J<74߬`uL~c`t7Om}T2&*9?HT@1]0ZjKrKU6K>r7S UbXx4瘔=5n82+qy mIS@: ~> 9TF*-_N&0, &ي>l+dw{5N,&jH3`%$XoZ3hh ORE/jI w)ؿz Ui:qԌhhH5 #^_>bZ YZ?u(cR/7Q 7pR=Y.6=Tc#ƀ XeDUFИuW^˺k߰䡿HlJD6ϗRnXLbNԉf◷Zx5<4k @% /<ҞE]mJ9} U냙 (R|"q}72頌#nA5 7.v] PG-uCcIqіUrv1SV9Yeʉt K^GLZW3-dVP<%ί>9b2AhJ>kƻI&CzRi%$ ?87* F7 b~❪.HG`}]Xy|gh3s:|D-zk ܙ/@r7keAJpݷJޥy3[xe-)']z:xr1UzmcG7i/BJ-VΫD+Lx쥪RK~ KS8xji:.8ZM%f/}8$Ku|e$ĉ2>PTԂM#]mrU 끜M?KQg_^. CFB܎q ;o>?>S\"{.$UfjWoM `_%~NXcn)yP^"WYs>T2-YC3 <˝ρ㬕<\>5x|FIU(C&a $ѱ}VOz/mQ4<񛟤a#׺g1vB|L0Zn%aZ;(|f%=KhTomUx:XbB- GW3/P7g(rF~R}Jڈ KD(?P٧HًFA4 !Cg,ShQ,sQ/33ʠMiga]6:GQIv7W~"4n"s t52\/wlq 1?+~5dnCiMO/>-n48g ":X$q3[hX9Y z#SV͚^8Fm%Oc}szE_KB ںX_xx4Iu H.s5hKeϻ).0i6]mx_'}po~n|्󊋝 2k `7zW>RXIg!`,y558Shk Na$҅U]s}No[O8!D7JJ `Z{ts\/+Ŏ-RSYKvWs.h())Uw[-TY|l`o=.O E,gL j` aʣ2q:"e344:iyZWz*Ç"aV4(:EJ(e9"_`f)[d$=@.茗.n(Y^nO$OiSiBn˼( Ċ ӀszTQyIj}41kJAW3 _<ܡE<ޕpI[-I2u[7\OpV~%+c-yTw4v+en.[ y})SVY\﫲KsnBQBDԀ\\8u1_I+ᩡ~eR~:!kowXp!6H^}N'Tw[f#hnfΥ7IxĖ [X2Pdo:jݓ8/n)R6N ۥIk3+n3l덟k(tuNBI#ݿĒmr%hH*>Rˁ5,4 ,^ NMH;?wݭڪty5L!vXM6S3ښحd-eanJ7wt 99'-я:_.3^L@3PIbL'Z)`s0RȊBzJY&?;ҟX4pTGܒSjp]_s[!:8Hc+]gogLdrF}oKˀé~@oB!sj/Z-rsˉ[Hgjq" Rڌ*d+#e`uPc2uì++(I vq!>d_cN;S$kN{,  \%.GfX8Owӿ*ʗS-|ma"Ҙ +ru3mvKQz_x>*^\([lÞhP-k 3Q;py 5p 9g^RFzWn(mO=8B,B3>UPD鱈 + m Sl;δ%G 6{+gplЮƝ̓e,/4oÛ_[,\/1ax0gEU"ZC(v&al9t#:X %,r'<(5lȜvoymhFeƦG &| k2WV:s[KKg05e@P⨈@:+57[BЅjSENy78EqCE$w2!]b_/C'S9@Ėm&̳w`#y *I̻ksbea2,,\7 wݵn(<+R#d=‰"CsTͨ !#^ݖͧ3Ksf WQX+g -.T}9Nt0".ʛ$O4MO-8DSs ]|I!pޞ*bگ/z82U"в9zHx#dA>$횹ުE2uRDl%[nX-a"Ȳ#8$slycjإ8Tv}ϕO".: @__bmJ` _ š#8t)a%t[zZ۳N슼(~`=Ң;wJ_BmTɼz*y' s;/5g3Ur6wcP+П\B{F=>$PbRtW֟z.MND4Dq@vSy-}fIU$e ~TJӾNbPbǴ 7R>DȊ;s"n_,(Q,㌕=IΏ {gn[.m_/@8ex @BqASi7 1=\r]Ǘuq&fn0ތDՕP{Uf/<)27>{Zg66:s`B˒:Qea#8z*N̛P;cE*^xnm^+= .O 5t,o>eN[)4(޹Ue[uB?(8z sQ6ǒfGPiÙeTf3[}#HȥQrÕhsu[32jjbS1NH Jl;ŕ\3KLk7Clqpأ5~O5idvzeQtInؖ͢?_\,L0<5 sE5,E)$ 3E\? 0oI6iM*l+Pia*{~w}Іŧ[YC TV7%T(w)~<|8Gëj?ZŇtC (<(2S` JaisS^#1&`ishL럭쭈^`bY\T#ڣgZg\EDzpmpP"[anRx|wȄLd+cg6粥?STBYd-D"hj+EFBO'OZT7BJ}A?y5,5 ,^z WE+P6G-A̝Qmbɮ's{DJvBS*bm`nb#U=VAN0pD '8(xx Z}u g}>PDxt9xZGu>[вOMc99s &l 8ylЯ&|k;w_< _ũ 0ډEXTA&}MJ3_\Cft^9,b+S^wqv-DGR_ABiWws51Rp95^5JC>"۠o~QEAg,urcЪUuzo[+~r 1QG]Z7ROMIoPkʥ +Bਨ/ @=.6]MלZY,vԝk9:tmqDwmφ2B vEiJ#|On*܆ԅ- ϣ;Y_9M/&RNPaCgUs]9KL$ΔAܓ gWʡྩ@bjlGҪ&u98ϸ^U etzf- l`StWR.GN>!%5D_tgTpͲ+ O8f֒$'NWr3GJtHgSL˒^<+ ̤eZ2) w:"R ׫XϢEޯ }ۖdIb0.$Q&*(B=]iB4tYH{I0Os{;63`3OJoތd4[{ zbs%73j$||?uN~'ci13*r׬Sub4FN'Nߠ:EQ訸DIS,mC78ݍKBfBF{@(W8D}PsPB4 ?R: "zXHSB[-Z>J3* Z>KbρTgDpK»QiGBC,tKrE >aW W9e֌}j~q#Z C::.LK'׍$Tj$**¢4jR/BۿlJ F*3^K?&.cw MmAPZ)wַOȸjj~_dKm%"")&. a{sAɁTK#pU)kϮx-l5kJ62湁= sze_FjH R&ΜW[݂Wt{\ x0dIxh~fjjHJJ}` UGuBR~L)nUbH:@,Rẃ "w)$MHɊAz.3Ů a.K"VC0dTJr]^N&evTKV6 ]AŋH@ERua2 m(w< 0clOw_hnG t` Pzf.]V@ @:aD\ģErQ'1 !smVT[hX2x1Ѷ7S$g̿U'$汞cu^g[(9'Is^ <Dg@8tBgcЇ} 5aޥ/3ȜH/0ώodOP1+G)uJ`/u>ٮv/=ײZ>!BaA&Bdt_B-wa \$ޙ3텒`7i+s !Z[>C.XQ+.cc%E)dj;Ʉiy蝊i!~OF:@9ԛ:q40Zmu'_@@eէ, :(g}`P;0/U9`2O#<e?-̑-ԫgH@( w%Х7J1P!ܼZL#d1,8G*GKW@Mi +֜|1xu W(Sp^WQOdvMZWG'EUeV͗$]pJ? E(&1Y M@ :<\pHH )oҶWIcgyEJgU} Ut]= 5#gy";iAFypV/pwȩb][^,PoN%&w;]Iϸ*z[% ^.%fDsGUi]x:9U䎶_m*IB>4?M6T1PI? Eg]_+aB͘/Ox7D&G/$_Q9Yќ0;A,ElII\7ǢW>Wr؀g9v/,ɳۦ/ rb=zqOQkW y-V,}/n^w?SU,Gꛝ}c#}橫`bDLjZ5ohڢ[v "7E’1ӦkުC6l"ƶ#e[^2Q2f\n[/w%d@nW븽ͤTJ _Qft0Բ_:d %zݬKYc$1*zz 8oe9>wEȄK},27@)Q3)r~Y#D{b[C-*ipx=v L`^Gƴ|<9BvB2!r( h:}hnI)m< u;"ti:C15BŽe&>ihenm6'xKT W"@x?{>akN}Ho g0$_B+v"-Xº&.ILM@KPkU3vB/apWlgLa\*3I∟h%[G=:{1:iD 2LI#( ܜXx\> rt7zؼ LT"2>2YjC,TjQyr#!Njb|jܓWQJOj T؟qi]b"k ,{{1Gj᡼ʚr׮/ h9p;b{.136.~j-MݬBf ?/8["k-õYATU=z89XhE9NwCC %Ot"miA#^ zctXuSDxj:i1sed:Kܼ" 6.b\(apH^28'fW̐SRYt܋ $¦ެFLPML0!؍eQ́as&JyX)R'r^G*ڒQݫ|9>j~|xI_nq+f9BnQKCW9F*c^^l<%{!GA%}g 9 A&r`?x`s1ߪ%C кD8CNYdL4/2nn帮xjDEFgJyUFr0cٯ]_.2H+"i+CJ#qqvG;K!> RE9C~V=u׭p2m T2Zq%{ H8g>ӍJS%''S' (QFFxLpN!Ry{.`~B$(URh<PlƸj[-1%MU(O -^ڠſ XsҗÄmr_0 A&u|)耪h zzL;WKQ3^gp#Py`حb4Im \ZSg4WNpqRX!WzVrmKTljHM(#ݏCD&.{mIO#COF:*]Bï P8@wnq*dPK8}^5SÉؼYWilOsčsR]9L̏bOb =\'{Λ 9f5<2(ΙT8R,k2n=gGg[qI$؅Fʢ(@T{ZcO5X`2Wu(˪JLV56#rz*8K㣴V.tBOx^\@Q6N׆X"mOm Xu F"/8/&i~_ kFIE2GqFOKg{9=}=7ޓ!C [DZ2JZ]ak3?&; +N23b',JJwl1QDB P|Wq2mR=ҷ7(|j6)8~#g&My[✐ 2Ďp vǓ@^q6:^]+G1DC%:S.F`0 Ў4'y+ETefAv rde_RB驘f_ӇDk蔮 { 0@#Oc,.NYC;v5tIMUӚB7C8pkk.q"PȞCW5Y[pROHE^\΢Js?mԦe`dr5 GΈ7C)#ZF2[l/Rϐk1P-VT5C ,l!y 0coΝ1u/sԼ~Ec'tO}DPv,jްA3qe%4 /~p{˟hK%R,oAk PXm@,t_ /u(Ղʥ1sAEeV=jfbu4uLJhiu6 ABX.rv1kۦwt.4xvm|6J`ʄd0bfF;֪T0Y=lԀ`f+seuR:AtZ`қf<Ok :d2?d.JI"˽A9C vY buJHis׀vLlR.BKuvB˾P_eeל'|I 8+ƚf78MEtTBmOrzZhR>7 ȑ^Dr0;ӄzo=-wR|སbԢ^ЭT̖|0o9F!o}`]Mu, 20Ld:Ŷp!t tn]fВ'hV'RYq?*0yY|a9ekL, svީ85npm,e6*: L"?LKOa޸B>aaٱǹְpcl+f'.*]H LYQ/ ŇvM3}y9"hp Y_;2s8ာթ8}te4q5 'o锫[j4"!Nv B(ep,nvgΣ <5U8|g^|?J.ڮ9%҂Ҡ 4KI%>\Vyxr cGJ^ruk,>{a%8nK6 9B[%z`þF-$J}C 5?/c&Np$f|-Drc;WKZ%FHґTE %TiO=",mmGEO_GQ+q==wdw%K(T$yW#c`Z3'zv@'Dm_': ܰ~=7IVx}aEȜγN 6f1@֏DzKϵyKiHiZaӐ9X,Eu _yoR)=`KAn'2Ҹv6NAT,N"aVQqZԤu؈Fvd7| m`[pʦp,[9"`X w7A=~nvN#Lu N6[^u qKE*`@^H<rn'*37r3}FϦP(l O&=W/ ]eWAE% e2A\S(-SsRo$}I&'we8kݍ>hoV+|Bd,o:>7-@r+̲ Tя\fpZMt\c5T i G-\Ů P5  >bs7X. p6PRFgd٤?63}yl1x0N͂& 4OӉm?ibd HWP b.(nğLg$j E/!-c;I%5KԔ*:wɾI`2.OE+ٹˉ3久MbItEƑz2/ RWLBy=#4Fk.~ټ,F9b56fԳSH0"جȰFŪaX=jJ̫g-039^f_ȳ'^Dٌi[TK5,+gyȔdQ'eR@A68L_FqN'@Zś%NKeRlgWvhXV0G.`C|?O=dDe6yXCjS,>}ha>}Q8 Qp6K %,=0-ؠ~cPr5L6RP͡mDXI1khO)"7IaƱm,8s2ڎę oFY*/ݦQmx:{\ Rޑm9jB-ZI'{h`:Wdŵ%U<ޕ thD^.=/fҀ:q6f'2.mؙ4sq^QѺ6 QbtAV2! >s<ʹ %Kgc:D^ 0GS4'35:I!GiJ 'cA4cΛ=`IptP@(Љ"Ǿ~E>WRh~6SFƢrZj<,X E.qЙwn$|fA۴*{-ɍ,ܪ@DVCw~u+ WhuFr^?nӘԒ&V3_zߤLR 맩qQMʦ_YgX*9hV:QYċkb29 3&ݙde~"O,1W_>2(_Jw./EDp+^OD=ށ Dx"σC3fTv!17G[Q¹R(HXvN滇ag􊿮w9/w x.?>tTg5MaZj|QJMϠ"/}KU !dTAP@Sbsm^m&0</KƃpCk_L[$KqJj$ב\s?H1#&wTwhÜ9$jUޞeRGbz4J8 J tÝs- ^4ڔ[ uO @ pd]e"Y+ebuCܚp_,G q<$ fseqcYm5w0 N}X|G\,pl-'sK-'yU)Uz9O BnwC;8/*8CIzs:=BO*P9?Ã~%7ezExJt$`A`adM̉vdPgбk tx!B}Sv3rGeDfhw0 Mz 1MhOgJ-;D}g[fBk/ iG_0{yMIQV[A:{tq3t2D<4Ӓ_)ٞ wuK`y Wy4"4{"%D($=o] sKXX'm871 몚S}qѱX鿧L@\rGӑ`[ QV[GmπE׋o0;akAV5_PtTw/} ".F b2ڱ"npZ?-HplKsyLW0SC5x ЕC$YyH~_ !K>T&y3fF|h#;NZX 02 or|*M8P4AFEH5 /ҡ?!AslN>c $dy%?ZʗJ#E4kFMh;z#8"3I`0x 4; ly(UI5jO%[6*~;,̨-Ի 9/,Ag' +H- Tb7" w&-)fW7ֶih}3OmGf;n#ÕAG^ NLuL6qG 1JXOkC 'a"seY Sٙ?gm44ܩϩ\d8JB *~ fAOoKhnGMZ+X @aݒ`֏Jt^3lNv;;BVLܳ(Ll KzW\:RE&<ӆޑxݖ{8bJZ"GwwLzzPqwwKIԂogfLMp|NoZsQ)!WPK<{WK + 01h3M e&yޞA QVqpmmbwUpF?7Dqy?藨=acSI@/Ox& ֲ n΁\ wI2R!Aɧˎ~)~'I]r-c-1޲+móyւIjJLK^&$7Ds.im`ѹ)&)G .ƪ#4 4xE+p1Z^ ajp^tZ{$!Cqo}Y>=l@yASv^jN5[Q)uPTvš}FTrp{/vOx_UDa)h{Ӆ0#̓„}U2",hHDLBtbq:V2OM.-:TЂI;ַuvyp2xNQ CՍxOB3N62h>NM!Z/zo&4}ts .1qTVN=Sۘ>ϗQa,wD]Ƨ $YH j⽨h!2fQ*=7.5h&]ɳiX+욫qaX٠$';r-䄲Zg"CbM`3eM``;a9=׌͛$N%%"FquX FiM)mnкU#?j\H;EgA~Q-񊥞HYdacMGhfRC}`!aErn֟%󳭥:Κ#* 5C͜T`! e"?;)frJ z0,d_׋ #BesmFpY-GPx+AaRbɳ.` GNjEb9aزRoVuPe\{J9]kuifr  /IsJb{p+dFmPPt>4ËD޽28ia-@}0_tkbbG>DnH,\aAw=}Ai#6ZmT!&Y&JWMe'%{i ׯNCCBz"bK+zC$otmH%M(ؤxW WEǸnLBG&#_tFN~7.wމd9bZJL'9`%mu+߮ٝ>Ӡ%dh50 dz|q¡V愠؏rK#ezo|41Ezz$igl̇͠X:`_M @${l//;zp D l(giէ#JPpWZRRu秽2dPFW$.)>91Г%28&nHXxu֨%'-.\:DA1'klr N뜯XyPVJ%梧agFd%|;j4?]ʰ|E(41%'Wi *S Yo`QWJM# ?gʽn.BHn״1nlwNb*8G'G bBW3}43Dö e/`Fzՠж힅ͶS9qR)wYwXړj4;=S~ֺBAsHMp?"(lHS|}7n֯}n}8v&MJ'KZtLdG"+l Wx 71 QKvGƻf必/h'xw)N;~E0yfITt 9G@O ]y_" 5!FyB4XJ%i2k$؁1К\VEI~#\XLȜk^R.$G;_>w!ꤿąqG*l\Ezթ?@s>+;6}t; ZEӂjՍ4%Ohp?:@;gq*L/PKoCj2QL7c5e,Mn_},~ٴj?&bUF'ywTIas[2 ~SUinj~L11" Cby:֑29LҊ܋d]w+dֆ XNq˔KLսX2#4ӨfRTyGa4Lvm=]v5uGILto)% 1E-^tǺEa׾Ej{1`p66PrA/I CpOLX\ u'VjVO:c3|ZqtJڿʞ#3uv GG$Kُo߷Q[6ֲ۟v*D$+D;sg}7_8.[ΒU"lc(u i&M ɰ7wehʼn?t V+`cLGS#w銁Zz`!{+)BeL3A;< :'6w/>t1bBT' O .+ I`n:7*P*)dJ'S*1K QS~Ԇkt2aK"2]Mf{Ol ݁^GB4߀uӏnɇ_Lq# {wN/{W[9dS uG7:Ċ8K%Ff7Nu (0.0љkMOο@sfj*Nua_ʍ4>1WHѻ1ï4⁤~*' Ҹ#p%l9 yt|pA(P_oSf>Z4=V{.8ړeWM͞﫼"sUW IG>Q+j"ȧP׋DwryT [;6.!E2c1{u)M.  \: ǐKUB9`{btSe. ww1-"b(N<ДoS`8|r ]ţ62ⳣ Bsi$ĥ(eP#< y1Pm`T?zCEd?@v]M#p3 \71ǖkwL˭CqLt&@-.7vBTA tSFh C FZM|w7P!hb1m鞑S"/p؊ʐ'e^IFU@!q0JBXQ{vu7Χw ) ۓm68[PхOT|5Qi wL7;􎳠&JL LYϕbq3Z$\Ɇ9^& V$PLJI)4MWAu7R ?2{:# Pޑ\G*fCW(x .sֲu8UTf[ȚƍPsbkFy5Cnt-fO)%z%nԿxq:$لO*; %41q{R[o+gww" mdosgu/:=T=%߰Bp9};vb[#ݑyKt)X[bFO NR-yQq!c|w6~[jIĊܹUC,7h= K&1n:1NQ~ @sy<>#~rX{N϶N"VA-U]> ؒ =uw)*ŏ,d{L=͓+@kM,:kHnn䱨5Z"l\w⧚~\c=bHcx1Qs2f (5exQ(FR6f ,b7)`*ٍ+l5 /Le83V7TNsUaZ \<"-m_4ԠXΖMaΧ,h3tZkԥu*4pu~^mgoɒna"f NDطBUr8 [w c]~Hxĕ{A~?-gI:*CTc':}طnz@ L.LbGxY9@蝳_갵F;K=)n?uk?<^w%AhӾm>f.RNzou Hjþ) i@Kpf[ _Jgtʧ>gTU,A9er|X"G&-YN؃^A v8)*AE}0pOĝ, gC wK枓{]B1T^Xɡ̾ |4%0+"ʖT",F /|GѺ@iz(̵/*ʩ ((}[!8 06'mFDHjDzѪ8pk,;p.ʤ}$j p(A*3?էJm\"+tX1:I8W/)a9M|v5kSZ<{=*?ܗLsb@he,u&) =iB u I2OR= Zid) ?pbjsX)P݆dy\1,ةO~Nw؜m!s٢~.ϲM7$@|.m dm+[iLә~{[;]+y¡rF+^"T% (Ѳk]x_P8$j"Sշ<:dla9hh:+e2 V>'8DMωLw{F7E`%zmA-zAP(3m<<г8ٺSoiIB46J\cA<Y@*}p&ZӉ3$e-yPrH'K4q@9گl ڢ˪c:" OA~YfbxSkWXkH94i], -iïa%#Hp$:bF'qLчbΎLڲnlH 3?u 0 cd,%MLKDl6lV4@JHhH?.2"ADT5ߩeX-d8tr0[r;,+DeD.8j6~Ijaәj*|)bSj4V{"ED@7z"tUS͗Lnqj`=n1O^`JG qfIj)y`#- Ohɹ X6viE?;2LP{ϓt贋 [o8$i x`4 ҪZd4hJ_"q64S1Lr ]?Ş)y17AZ&9gg͗\gO(pvh(Ëd s1#;M$_ߗcdsqp+(5(oꃛ2o"x26,,1C[̭1 Qł͊‘ro[Jyt>7*!*MP?*A+?O4FTJuqQ_8KFES+P%j^K"N-qÇ}ሾ-eKeQ`9N ܝRCt3}^u9 rEPw,~)/+˧#seuhgst~|=9ǭi3+ńD Esv`fƚY}i_0 n(xѩD'cp9Ih( Dx@"DcjjZ#3APօp(Ԃ?p[sV3E ,"dzdr GɼfC{5}e?|v_W(HR@6_IFghmch"KG޾6A]͔~|h $TID- q)*@9 i^|,\Ʃ eIX̓}q IQ>-)z[ ?%>jZK]B.Z&mܗB νsLz< AF6păR['0IP̀Pl )vBǽbIVu9~f45M6&j/Dl :~ԫ<'+aM:mɉ:'Se/2$Ht 5 Puqat7n^ 7f.B!wECNmIꓞb|0 ]t'.r=:OU-ɽg(ai}A)}1@"`W%NQ{u(ĮoeB} M\-A.ΘVK_b@|aN&W+QvTn>ԕo%f H{=mǛe9:1gլd\Pt;ӕV+?-[Eq]~R0ZE'Kl$ ITSHhf>ӜwiB0ӜŠ'R([(ηGY+ӑBu `\~,В8zbǻ~$rՏ1!Ӭx(z4]n!2L6A4aIZ3s_ cC`nހl5|(/ʿƶD'6jͨ}kAMs78>fuLDr_=]eZTMPJwf_R/m94]6=ҹ0Wׂ $^oSKW_py3!딨daP G4ξ( B`[ #eSd%̭Bãʦve/>MTkxoQ9e V:-nisټ-_: qsޗuCZ1fi'D^HExV\+Qg/֕Dsd8'}o3EdfG_bNH<5qXGi0AWE Kϒ3aӐr&b>B6-«Sᔽ3\&g[z9l8iWj}sN쥨hM=_UqdJx`ܝ29^XGV:s+RP NL͈QsG%V IGU<#mJ_g]PXm`N"h 7~9T 7g!ZRloӎ?N~0"3f?2 FGYTTa+U)oDcGRqn.X]tﵶHvx.N}JDΨ\9"lr;+ A8i̓O!s UC+J^ EowÒĎȥبoH2!mXF!~rZT'+ì4݉B$&gGV"ڍ0wzLw t,B~_ƇeC/.gCdlP~NF.:]Dz:kXbsĥOyMoC {V#% @l9*J`dTZad3lfnkp7.X'Ǎ ݎ5>dٶ,R] @y8<)ݞ+W2DUiؠV2*=I׆r-֯_[b[A"{8`jPTq< u4OpO5)#ןt6,"8MȂ<un#G!t=8.#yWp-󹫄W$o>3R@2kq`Z/6V{Vy+r:}*z@P q<}Z9\0\ N>+{!k}1#޹bzjx|QGLN2 ]"=nZ30n&ouyGg(7thB6RRhA0DVM}F@?,QDUF]wwcwJ(D rnE 1, G-'k ?ٻIVm-P}{TIF183$?%lΥ td= (gidwU˃{ &N%Am:s2>1C#Z˧A%aU9:@EDm i7+lE)}ٵk[Z72DY*p/.̛ZZQá⡋.߆PlI-s Ԇڿ:G-8"a%'p4* #F´~ʼngpɓi ##rO!5O%ŠIn.ǃ_Kwk3qMՍBvpBs]g0}'Rҹ_D~:3?B(f4|]pȮPbҊv$` [qd<]2t Lg16i?U'2b>ƚޅe-|Mq?GOӞ%%cdve UNGJbS(v>b`>&M/>yKE^PeS-}{UJ1R{@;o~ib@=l`o2d8MBs3%<kͅU!5;Y2^A&! 긇\R;D}.@ٟZˋ*9ʱ[3VOЌu|CWٌ)rA֊dʋ8s,5vy/ghU.k@M?>huaRs &:f8*@T,قξ,O}< p{_XWf(0uQ)kkL=_EnZ~ ` Si`ԬH&-Ҟ[MeJ9TyxF ^Lce~!"|l~VP˹ ܛ5״=] g@uu6 %,涑i0ݭ7.pj0Ktu(pJl[ps˳?}>HqCJg}eU77B bJ>{(iPasrKJuT[7GҏVq1m?2eGoetWїb `BxۅWOeEkG7x=|k8tƐ醑Y6mfP`9V}o'GB2 *yY;P+ vʋ6Ęw >R~Kv촙q*EQK[ PH]=oxk!MD*)~inuvw72[70F=P d36_iY iy`Y:*V%ӑeLnYʩsKp={'Nt8*7OpYj5%Ĉcyˆ(Iꅋ$BTEA`j Mlgh|»g]bcn]w@)bJ8Tpd2|$W2qS&D~m go4Z?OVM׫M#SHw>8Fʵմ:J^OPhR 2i.J!T{_m=s=X;Fݤ7b`zR ݫ]TĤFpX0@E_V{X=ʆ0@ $>WCP蚠n5}X689%/ uN,߄!hd\eHς)`fy-lw}= It *2 [jKM-VeՔXu"#"&f.!SREDwO w?k\KQb}SleKr>mحZ)ƈ ?RV=/Z2,_s^uK#\f]ܩ ېYz^2rDloX9؋{TG/ܪ;5`kJep*$m7`s ``!{\+I̷|VjFQ6#Kы5;fMvæeC g/ԶJWHrP-\B1JC/̜Yg6RB@yc1XH pZź4]En}2X4$-fW{~Ixu=r,[&jK8c PgZ8$0Gʁpae*-0ؕ1цqV\C HA_"1.>cbl~#dBHlF7kwE}b0a]v#F_hzO cθtլ;]A=T~K[K^6xwӊ(5[-rΖh) R9PC{P5D?B,ipRYX:IC60r8Y=@TI/>c] 44Al̽!`D.kQ36%{&ml>BTGطe!9SvXBJLFji^ȉzi'Ku8!Zx.]Ce-c ?TrE"4H}$EH%$`}.S ̥ΒYX8eJt%g:TU)TAF|7mxf>ndT0'wnj*T+5 ZI];sYX41;7|&pdܢ~f=##a1,GW$ 'uڢk$5HJ#Ѵ{P!˞a'4:1;ZL$uޅ6֢oa}abiB EzNu3kQKm$_p4a.ɍ!TA ZgJ,xUSz%^$kL^'%<8 :` G[p2I,@TT~CD]Ⰿ׼@aF>ַ{n%a,f 3L0#}Cl_"Gn2>ϲiH S4kʤW%!]-8RK_w-Jʙ+pv2NՑ8=ubG+l܈>83\wo|eSLw)*"3-zE3o^P'1??C\'1m }:ceٿ>HBZ2g1(ǍA+ +38qEjʩ~4iŮP\/@()Յq=yb/ B:wDNABv9GeCQ-UX1A!9*?g*[O& Y80KUemRnn ZK䶻rC':y)oYm !\VxW4AWZX.w&ЛɭY8W4z?b( OCݘ+YgQ\ 3#k@jM-k'y$ifb/NM;KyK=Fό.҉–sT^k]Z33rxd En1rϰ\?b;>SJ.νk$@bVFs*A+2dqs7ŗk(\cZIQ,91_‰ 8䲟Gᘳͷ&1,`Q\DK/儭:%ʢ#_f~W˄'mu jŻpi{N:ݯK`(cG3roET`B`2Ob.;G% z|yVӔYJt0<Esif!uIuE+AѲ4n_C+R_nR#e PDnE:n Y&`G\ 6y( )$o"91@ipO|˰Hts?bQ/ ~Iz=f$;_,.8y#4cc1iQ}Vl ԏBR#ü"EkC`cy0q|Rmq{p|$Ÿ?c9=QZG g;U-g0*LQm(-Ld2VKRs7h jkF8JFZf~|=9:I˻# DȨ8<[ҳƩ:ա&`:Ո}TՑ)t?Oy_8sc-neɰ)^ˣ>~┙@;?!fj׆ 7Hs j;2qVV6M{ha̵^Ĭ,qp7zl![_8d9i5;GuMVϵ5QUĹg";NJ{Սr^Rq"?MhߎDWLBdl}5|2P-x_ "^ns*cf(p3\~k񪅁6=3BUb>l7:x8'kA놫`v[R=Y_b&pr$fWA {م.ﯢaF%ڪ1QmB/rJd.N!eI Ѹ$B) CJ!,W0<B TJ "кz Pj^P]N@yW?W69D{LFz w ʽS Z-蚢p?b=:MJEFwSQ M2)ONRfTFY"(eԔ(47ԗb#T߁kBJ z7 ijPfx 2BJ d{qyg' n)c mϴ6џzt: 4!OSpk2Lxx+$KGPB,2VWpEA~~&#o GDso⑳7e[}"գ#lpF0zx̪&ڜ:âgϰrvqelNs# =A[}oy7ⲳ@53}±E˿HT3|{PV(+3G7n'FL^ֿTOHjl_փ(u1!#'l#XM!rc/1D[z 8)TWDeKHTMa^b*C޷j/_|iUx!N1IJ]'o%6 Yx+~MRPz߆ƸRջrp{m6! -vWӤyWM ud|!i E}$~r1d7PQr:8,Y-RԻS 0r7a\ a9GrpUwE?h.Ƈ"LFeCq "v0TNroi.d`_@ي~ߧ˄GF5O 0^%]T% j)|h1`W7k*@L`/O=Q%DM;Blm:SXമ&Z*@qIaξm_s`} cQN/0+"uCv9x:@#H=Wykn:є@R_# dCkڗ=zw7'U] Lku } HoJ?5#9`8Tj˜"YTq>Lٌz 3E cknt̢X)o~}ahD2`T{X%f}a?}82 Z$[=;xv*֡ZyVPR@sl(݋>1'DZ]YB0sN@0ыXf4B<,5:wfR<o/M3tatŗ:}IWaCłCJ`J Cvxrߩ⬾Ra\=Yr4{[U50#87XۥA Q8=ML[L_kŔs,;^3U70&M4Paxt c5 # 3n7} 3?'vEQ7\әX `3B5C``4nRz'V|jc[%s-@ sl#m]Q&cY'9vci&V)sZƪ23'.}un`vLGц&27q 1 ؋V*K^ e=<$F[ gaHm:߷^ 8taR]7GEM>(tnhT@RRR[ݲ] pS NA^4{C12n!]ovLrGUҁI/ʞ5^]7V?ɷ#T[˅6HH Sͫzk 8`FJ?`/m߯r#7 Jɞ7-|Os,"xAhaǁi_dJdIIwcϳɦE Rpb1"Mp glbIixYz'v!9zFd!{?W;B3}zdzMऎ*<]$c!BWMQ|D!tLS\@hDa0F] $(ƏI57,.7~i~_@ҳAJbiۻ =ruL2?unSS.9 һɼO\X'@{kS=>zt\l׌pcr Fȣe(]qm[ n_0!ʹ՝MeNR0O:{wwE[b6SbH#RQ[-M7rNl}I~>n7\6djZAS "۫fũ"XX{GT<6`ݳr9hԭ77ZJ}M¤AGUFGiTpp8 S,Puj2(:Ac,mԌa !0lb+{`\hMRؐO3\d6s;5ݸ^Z@p8V$|5wk%_ <Օ9FL2r(홊m1IH8{4!ZTLqaH 8[iwSj#Uܼ&ىgȹ{z1"ueZo!;s?`̳j X3'( 2aѷq&@ڻ4Ly [/R͵!0&yO谁7 /Bzu \l>v 5tJ=c*ZX3¤H)u;fBDFIvn |̌̉Sw$Eq=w"ΰN!C2|j4L"r2N缻2phv!K)*p=[i'Mu"Aeo5ix~*& 2X95;4\s/!X:|u%fa  {9 qX jaN'h@Qq\Mt\k0@-j=fՑTFO#I9O F+LV|n5B9!Б:79ɚ~%fA/&$90#bggE27.Z K m@1Zp]{KM{]-cKnpݐuב@2:Ю-lO>R vu;FIOM~ʼg(GL|ZrLu/~d99?G7f.p?Tt}:A[i*Pڇ aSl_/ -P5HHeׁ8:,vkQ#鱜ˈ Nrp{ɴ9 ~smES N߸}D8B,_0nbd&9@ʼ+K+T=> u0?͋}vV|-85T[iM:G~%͜<)O&Ӡ)aHs|3sCE牝jIJ'8}9ԓ9OǷeX =L>"U/ç՝N.':aé8Rn=\E;\9$+Y̢qkkpFfk'8ƒE o_-$ND5G3h^pAJn]Bh~sOhuL5ȌA#Q ƺKϵ*.ʑ8c-oE zkbw5>FcCk,iJ0{b nPLpE)=B6P;;x:כOw])ӠSH k0U/mA*s1 ;Qsay䪮ܵxa^c+C[<@ߟ oYh*q|ΉayI6d[ӈPi>7BjNky^ Y∲Fy̰IXc4HMQ0Ё+ĭx%/P7:\iiPDiϦpxiTdߎ3 S TOAXA笍@Z2aZH"QgVe8؞|;&ڔ><{m\4ޛpԾnJJGܰ~0QEӷ !FPG^B&Z3A98-Ĕ߷5L7k Lg# tuT/V#E\ լؗ,Bdk05kZI˃[5Cxx#y%d>;n }i\ @Eo^,{^@PUr0&ˁʓyEoσ&k, }b?3Ƿˍ$ cET =͖/\=zG'5ޛ)F~ȝ%-=T`/j%![&yȮrq>Sh1"8*gz wenշ@@V>p7p_D:z8h20O`&H7ЂDA"6*ΰBFlqlhCͰN*jWK{쒵EDP X o~jW?!)Lx77ʇBA(c(d~q ~f&-q2B A~G<^ 8S*$G(1vX U9q'tf`Q4$AݫfQ  :G iy.>>s]1]kKoezAz"& [tG]W^8ZfywWemuɢ!°lחM1O _FaX \}o<(|T B${s P)yV9=GAJEjc,!\lPeNFbޓ4j$X``!$ s7R-;Վ#!BH7p4%+P(@"ȎZY&{rL: Nr k8>8Q0)@/^{!C~:o/K vMAh91,MH !즺J&0MXC f2%ƭihS) _Tb6p[8e;0ܧ qxC*O`͵C~ܖ@,0=S>@,fӰ.fLK r5бVU#1^?ֱ/ݑ}hdqLxɂjN3)"գjITТ:H9窇R*'_?H45W.&mgjIQrKfz=tD;!׼$Dc&S (rSYJҤ;wH7y;5l;׃HΓ3w  k& n$qZ@T,Ī5N{˲!jMinRfX34mz}jN[&)S $Gh -a_1^ d=ׯ 7@%3Waw܍zC_kR%eo`&5X [yݻ&/n,+eci EޙES{鑌ߍḩ܌Qߋ@XF@?o_,7O1Db^x D'>0 YZfPortfolio/data/SWX.rda0000644000175100001440000006117013630677273014520 0ustar hornikusers7zXZi"6!Xmb:])TW"nRʟoÞuSlܵBSK%oc7W ,ft;uf:k/ކdr䮸Qbf OZd|Dɟ KC<uZg"OB:l&˖̌@!剉L͕$ 5T:ql (;G%:z!B\֋gYf} ZC׆2a1hԩ=+|~ݏR&bjBYݛӳ*В 칺}MWsa򘹚Q4-$HD[Bw`DĂ:=57*ӿX¸+\T9iU_p'?m|}ӗaG!c9MIҎw$^ ES}Wq2HtkHm(+WG $ u=8i1l,-4a){>+DTV.JND>QO݀!/܂]oUdݮkM^%q{CASR2<?Rse$4R8/Shm(6ܨ oLմaBd_5\&/Sq1x8g4->qFT >0~8/9`RnG8jZOaF^SbC %ʺB2O A׼U-ʉK&3X`nrL7iL0H7!Њ;7(z2)鼳٠y$i1_hǸ6 J^@~Í`y^t NPC P5T,EXPsW`Rv3D)"td?1+|wШF='yJ8vNg}CvScp~Y xqsՋ%)xrfP|ԃ=mh w8ǜ@Nri;$%2AlrOk]z8,Ha>_#u x#AL,Q5@v$g6G!fۘtpjFܻjvE!6\ d]#Xn'nʓ ?%&|(?7ۜYzۚcsasV&qkп`!]Imt6bjEI6'-TA ^' KΫΖ|FZL΅xyD[^Љg {'ĸ3Fԗ};EIz! ue8|6h"%%Ѥ{? 6\# ^>'L]{%ĝx [j5qAB>g+/G/|oq$_J?V9 4fl)vTŸBxc>* B8ARcz(QU6.!v,s_N#zU[_^xǂ^ +EE|p_ L7 d۪x u_=H?Uml`[1qLW֣@V~Y<Q70E~DrM= Q>a Գ>Mm.">HQ\|ocܫgc(ms D"o0e<.;Nϴnc=7F!6Z4xf'd2.ai6CPmm9 UA{Xw$%BE~a 2lGj_p@\̳X~K:O9D@Ԓ'5EV6~O^EԼ HfR={n} sԽTKaꘔv;*H P: (Jr#C^o>E'm~/P*u0n ayMBIm7}iet!VͼAuf\mѯ|F@l2Yuz BM/cO CHRvf b&7kqeB %X͇g;S[d&gu7D :iV5=rEܻc:d<:T8uԠF/ ~,W~̘nQ3ݤlpZ~z<,{.({K"լY*P\98lzuj1=x~DaJ;zM$XopaHlL  kHPNR*H W0(ez4w xvاu'Xp*Ķ͵*gTlR?Qs)oI,ړq coDHz4@#}LA5Dg_91 Oټ4:q |8#ekp wk^j,F*Tj=9!擬}b*lMʮQ[AwEX r0au>@U(7YTxC1O";B8wnSJF,P&|QM`2^ ^icE0Ȗ ",S`py꺷.KZi d꽺Bv+E6w`Zc,UV4D5Zs[V=̵S N;oéq6AC)Q^6WF% +kHF(׽mc!_OF+|>Gbu#٩czA:,R'yzpӶ7ìno·Ҽn{Ҟ >]$S1p)Aop\tO ,}#0 Cry}<[\#TAٵAr{kg=M(Pz>u}ފs1z=ȗvtwp N(Ƥq*~Fu]٫^yw){e罢qE4ok$%]Kdפyo(_ғ7pT/8S)6Qѕ6E9ǖӁ8gнݶUS MBGGdnE|Z ]\BkA@jVD%7ڷEbPp?-w80\bܚ |5[ey_&JX'E؊2įB3%6ϽwKYxا{y&lZД{rSeBM겿8MTmU$bW8TQdUH+XS}zE1 ;U3A z0Zvz@)R ? Y)`5"H#{u#1M"ieL5gw4?Lg4: (҉uH;;~6YfA“!shl]6D[01YgO36qF3 \)zSQ BQiiMk{Q4(n\?>8Da V^]ץzEr{˕4֠vō6y>B[;˨n p!WcNJUKf}*6Olw5nփFm1tM/uolxfiI³f]`c+C6Q1Z8 DQƸwZ 4G̤GLyْG~szBû\,lSB ^\M*e}] Hbv0 789aNPWw}iiieE1u W/<4/AQqwefl;ǧ?psZ?f`QO4MN7\|!9S9AO.Fzg\%mX ' JW ۊ#@[f`>Sc z3sJ%!g3- ;U\? zM ;щ{;Q@_5m+X+pRxm5/qJކ?%FӇܛt'oxvAG 3Z +j!sѯv ?uO?Չh;B%,g+ y7d.z^& ]@75u/ T>pajw`c%Bv 7v'"?SzEFe-?v.,)G40Sy>Pԭ6RE % ˰c0tw<++>կRڶ7;J14 h5#~]Em%t.2[$6zU!K aYA|ʈiBǟ~ج(7aPlDjQJڶ nQg?CI\J-LojrCA{4)LexLN VE mζ#Ӗ|S#5R`ȅw̥*gI=u b/F`Qm/}KU3_AY֑~P9qm o{m W=lrs3u)JZư7JLiBl٢"{B)+Me/ rH|؀7}8/A diwy׈0US h8W"SM fD;-mgRF! y$XPLݑpRcua^   XEH6F3r%xՑ$R]HW0@v aG r3lfci)&Wr_zyeo`R&g]A9l}"+ U-@#ZȔ2*]&g7BZj](kW|-^2ÄW6xXw^@aĝ5cdUw6$Uvhq6L ;!S0$/em}pkޑ{Sf6iSG>2Yop!j<\Ek73ӷqEQ 5QXٗӕQZ3գո>%Kޒլ!IX.wz(`* v?jq@չcJlx-(K\UG%UWo= $ձZC2<},QRc5Pi7psa{}K(7*DwF~u0t Q2Uׅ+T'N>Q="@ fK*q^*}":!koǙ+u[΄ȓ (;n}PwPtm$qeA{a)\8/X /˂P_^wECAкϊ<nWA+sxhvǛ,H&F,Mph\7E34Z $q:lZ)nAcnHҶ,` ELL܈Lm 4 (6C ^TaX7Oכd6kEt?C?:9~}F[Ub|3ʛ =I z&B乍):xBgvڇQh%SfܣS>݈WQ hxGG&(ב%$hσae9}(}"ox!to*̡84>ܼu:/Ȓv_>#w8 &ɚb[ exLT}&˜ʰiɢўkE.z3UtlsUgbe)YYmh\ "Oڛhju*ټ0*~!ˆ:Ps9%ʴ,oH ܪ*_\D_R AcXPYx3[qՑkRjsx{W"r* 7Cl5&m<9ԑ$% KpP-!m9g|Am *w}ɨ!$WÒ+ARȸ0pޥI +Y2-f`-jl4a}C\SU~;AW|@T8ea`nW Pcq f!<%tū&c|4LʋQ1ѥk8I|+2a2).Pu,`#Kv>@kʃQd4xMXQrw0j+8Z/܃>^!Ӆ*k7۞,$o+tB 9 1Lض|@D; ? Yh͸LN`J^]⾚߻V }WM!+1B,|( >@YN%Hm`8.b_%*^En5Gh7^#|Ya24; 2EgkR{6&;@Ka5ºj& ߨ@^,Qnc53ᔁG ]Ѹ|T#msVkkwRN^R?>ˀTf7y ͉V1&;"AtYZ񪇞QӿhS+fd,=|W!]7$mQjuCm ׫SPC9lW"-GXf\JJgԺ&2;O*c /(XO6yExǢ=b?i\Rvav#x_F_Ww-C?i^,'ެj :xFtchZsM}a7 MOTnxdd){_TN'b =3{Iz1ޛYX(ˏ+9ڻ];?EG,QsbIGO* Bouu BP7)PkhJSIN~oˉ¯{B=z}}BQ՝pTL{q%c5_ŲuiՍF!6@#%vZjz/!xqp -^][`N !6Sn}{jX{5@G>J><&bIK 1m[K/kȚMԛ523_7/On.u.Yf$.넫.yq}xݡ Z ,{FsLcf$bRv<ySu$ǣWkbH ۮ]QmG fb <d5쯽/BYIAO!)Yᡞ{# ƕ mթbFJ}hP t0ts^9*/2aO6cd_i<+[v Fgl39ႇ&֨b {Mˤ)#=rPJP}qJf.[Ml(%h|JhV9Ax=^ u5}7w\Ӻş>kiκfj{_O&t+2[rƧBjI<ߨ GbO@m"R( y8LtO^I;qبXiIJV-R J_r*Gf5$_~__r7/YhhV+FII}eA+Q4r5d`}y_f> ?-m#0\@ kW*':y6G3EբC*nwX` ckǙ| =>&jy ^1d3i'l6[, PH2Jσu%޻>jf|~ p$ۚ'O]pn[l97RHvJ0 W/YTw dlDV 1sH(TGx$L)gQ2)$*J te*6I]ey5q}ppFx}bquVKqVmlCi#,]!)2qF@C}IRE<ߏU!;"/Tw us:f eShD.F̒S=sl:]! ޷\̜vXYzD4PB iU7FCgZ_D8՝VBQjQT9H\GIћ9[bW%3w %P96dMvyl P8[c1'6˓]eœ_j ^Au9f x 4#ܧ9mWFwX. =OMDkDRѯH0K |ûd RT 5p}C&pc.:ߧ7yK=MRvzg-|ȏ]i*~՚@dȐv2y;FoIwmXKпp2#T k 4Lx4_]͉1oTq,GEX g"IzT՗Z/AS QZ<EϞ%/ll" tߡf0~5~P1|0rT',jD7n$<"VӰٖϑ;1SL+S@aͦ&#=ٺ1RQeY.iK6Fac a>kM2'>j7nMZK״s'[Î$GϻBQJ-F|$96G=x#g8m|$8HHX."V,U-@t $w; MIqݕTH>1z]^1b01\xWonB}õ^ZX೭,TрN柬fg<ƺETLNlmhxDi͵$ƧOd(M$+QDFokКT aD$})kX#:ϱ }2' 4fbNdk՝f : աdbeuZ RUB7OE~7lt?#T%BC7=F7eaZBW IDLH353ÊNb62s'> #BۿT-:>D#L}&M:2X:لIܺ>ϸvZjBx='"=fke s+5HH.Uj"Y#šbˆQ3RmSH7|^l<8)<8b6HwmbfΦ 7 J̔ƄE>n-60'!4H6{ږ&BR 7~0 y;?0w 뵣Px "UKDCPsu\ZO}ne"ٳIgߞ2!F||sO[r dԖf/ɽ܀< ;WX;F*%fDI&g$l/rӠr Đ=ōQcv4E:2 gr࿰v 1a{^)t{xzg7Ѹp5u8~ѼjMz:yoxgqu\9Aҏ'i=Єox#c1 4k@k,DP_-z # ][tmFa\LhtB9aJ%B>ie45?Ԭ/DӰP[5T~M&inAR~Vd5mӉ>.;3R/w!הߺbYnMč,\MC!itVQ)G"mp;(h@K,;{H֢fL`mE DZS]*A+x(-o.}꟔$+I<91܁Nz&^&;/!ηZQM锡 =M,4Ჹ/&|upuH ؝ckH!̽<!3k vK%1嗳U~c 5ɵ}`jJH <Jr› -qKӈȎQW-a5;1M,12_Y~'H |"ŗ *IbJb8GNj&2/EM6ϣF0͌Q)k-v 6dxВzr:!&"c`׆IuFyhִǖZ bbknCvTJldga5tT§4[F@V/tBhO0‹cv FBm"&:5b_MΎ6ׂƿY;͐\<'ʘ&y،bXcC1|mEKwD&sj| r:vP\Y)G9L &VG;%ZIh~/5ǂIԢķr353v85A5&33|tQQec8IvTo9p^408>,cB=Ȱw54rCef8]K B6eP xF'ҧ; B'6wQ/~Mj Nc`T5kȢ*zuKsڡ<ݐ#A׮YzPQ0\W=~MMі@;OGei5 S]:w4:} EСJnrh;:Ƣ1bVtbYg7kAP-KMj[|<fG4.#Ťsj ^T”1\3>Z̓`` 2N2vnu~HK"z;`ǃ)hj51#4ZHx/VUn3)G](w&W0#Y D^Y1#ВUw4$pq@حJv`? J=)kF#!fDx=PaXDm\\of~*դrюҽ!%Sם_y%ʤcdse*K[ /}(A흁ޯ"}LjΠ>4E{'%n؝1 uT Q-s_%e^)mTƇ+k9κw%JlP>v{sfUX˶sYgc8:1zY8wbҐ;`Kwpn³*b+G2SLaz/?Anl(&y6fRrωD ^Qh뎹ժ@6ciךĶ2h'#’},r g{P }Nl-GmGڔP=A@BuCNt%^ M^H )B+o5uunƔܠm}Du]ors znJ R7 7CxSDe;Jeqm4ȏhCbZ˽ٟ l.t Y&aG$r^}TQh\'u^:T2"u生DrGAUIё=@ T9fu#2˕v5nJ>E9Dzxm\ȫeoᦢ[P!wMR`R`zd y(ޕ) g= D^eT~C!HxcY,GoDv́͑@!ZWl-r\To*~5Ӄq' PJ%nS'*/5ch{'ATJ̪mU9zNV%aYI{9[ u2AP[ĺ_.S9Ϗ=cT&+Wt08Fo dR;)nBM7U{k#nN%.Vma Wh΁ڪ?0QdYs+drX bfbWC=.YDyl\ u}w1zi+1U[yƢ\&W&b{\`1jb,.7r=6̅ҁ\x΀j~=J?Y(--rO\Z3f9tAqs :3ǡLۤ<>Áb[!ʚ͙7tZR!f=Z YFqtVޤ\2xDFי+w Qe}C QivѲ4x<Ҙ.AGo!?ovJt[q?=5l)AU\j)ZMمC5m{C\߀/gf3o~W}vtvR-$$om9] ,dǮ|ocUwcr6~·,glmCv9VPx@mQz)k=@/jHnycqo⿾œzp.?O0LeVK_Tc5;.DIyFwYH&rn;5#p BkKY%ZWz cx38Z?,-LΆp@ OLyĸ%LɊ1ketEu]\+L>L&sgsx]?{NwGRKn(N̖Y5vYB l ꅉbj<`PDʒ79XR8'RgbϟYW[µXx/I╙.#Ra<-Y 'fDfԧ*<Io-%}Ů Z4dýC/]Z;BF C1 %)=^q k[QG&K\ -ܜ5o:sk|h1 e{@vVR5r>Ӑ>H4y{<OǖDֹ_gI/mQD\G rP}Չ7\޹4Y,},sY)zg>*ۡT̆^kO %nJ[nCZΩvd7Ѥ/=ɟeao8Ԅ2rm03[MqF;ɓ'g!Lnedo%E?x_ ({]}SZ3f=}Dé姦!'A^\୑X:JiQ&9XXE4eqӨcQ;c-kU%QvMJ]ku%&1EztFP>FwCX"DfO'{= -S?3J?ʃ+zkr%)Ӗ@#CH'OE0;}NH)غAt Lw<`p6>U~#_MӰU*ʈv/ʀTzrӢǙhإIOɟ+FťZ= >.5p涩ŇHzLG8Qul{EE 5*QV"ǕF5=${dt HPJ)"z}?"0ha8ǴY5oӓavfk:Nf{SRS8T2 !?V"9v Ei6=9ѩJj%v8-,AiP/ h(Ff,!J0l} N^g{rФć8@ި$/6DfW6Ȑ &^M/$z NU^Ҹ8 !SqSÑ7Z /$g\Ju֧Z;83d0 *vK&_ e]xP0y[Z[;z(9.b-Ȏ.) ZЛnZY֚YZLP&nWoM2IԦ*̗yz3a,]oD\h2Ѵ|QLJ\F :)ХDFQ.989- 2e>ZJ@v`x+,$uLGIЏ۫Kg_|Wt${D~Z0p=dgze6 &|7a#_؄caݶRknm>NȡSIf2`)%A!-兎f.rfsj+RƽYL&*b#H|EM#?Pz4:Kcp w)"SYd+r, 'TJs[OL%HRSĂ.Z:dcT]XQ\},P路 &GldN۶2t`4:01Z vnjrP |G"%^X$F*=Qv YV4K\ޚPl.KLP|J,cC9>0 /Zl뻕q=؀]aQW )C6q^$g ԗ3MgdHMͻlÑB92U¦uVD۞tf"5[= ELV.7)vٖnOA߻f%GNP}:y|wN4ɖ68?Պ2>6|_z}ꇊ剕N*Gk\T d?ͱ-NrV^@g`ziWkkKZ`bF(4 ܈N*45$Ǒ/)[QSct`^ 5/8wh}%z코U:Xc U`m\m04aAfaMcǡM0Kw~h* 7xN0fZn[D-뤤0Otxdml]kH%lWw ,x"4Kv& !œ)ȐYOovTrvޚ>R%eym~"qɯ ɂ`a@‰n9,'o A 63ByfT TzрQ):k~%Gy0B+Z(XxD+!f7U^^n(~IK*Ä;n$~±fv%["-K9C\32-wpeu_}ֺ3"OA,| kD Xk'EW\?KOlw =<{HLŠK~h39 ]Z`cV~ )IBydge\|qwyHwoHCpޡMxQG5B]`&Gq]'?5:<9ncEȋ|TK<}zN gR;qWK`[C~NV:l.d&KGjSFMIG|>x .Q%8ϱ7U/;7"HzmI8|ţ,r+)z^lkJ{̄bHGaB2q,=} )QJTN{ڎMXӭKl?`5ʇ ID.v\ZS_JQl}+^]3orSloTf 9u)y3nZʢ1mä^eߑ'klqhY 'E @1Wi\>T:j\!+|L+tA,KMU}=/QW沨k19(?4m;:Uw(r/zFP^_ԳNTvWxcLf|0ѠN(i=FV K뭺dO8TM\0 YZfPortfolio/data/ECON85LONG.csv.xz0000644000175100001440000003577013630677272016113 0ustar hornikusers7zXZi"6!X;]AS/Y*;h+h;"=`NWj`uӛriz _XNRniF iSA(iv,vhIsհo=ʸ"\sy)#> y=Dpil>WP˧^L zZ;oUa<7m9/dz d>,7CZ;w_%@e.̌&ϬP %G# +NGcՓ;fQ^gU+tӑ;NƸwh `3_$>5^8&lFuI#vѰ ܴs籒X4~#>FٹӞnWŗ!-Nmwb|K`耠w9?>bhZ{GB=G[t\;uWB!5od@o%l+%G[RO! n):{꽕*UK`D>Kƿe~ \]M4Ab^RJjk9LL6Ovk)DX?9I=9$[c|"Ԓ@{9 vI2\se л`M`s/oKu[bݑċٰ*PO"28HE)iJ>L'\ۭhљdʓzX>DظM6agë "/bt>5␳ub~bt^=zBTS3X$gy <CB%PnBKEg6!9Vɧ)&MһB͑E'K2O$ ~NK$u;z1Ӆ%C]t)uExAa@T_.>E#5V\1ёs*5vV,as/.x6&=K(PQa02|9BoeIA?WQ(x\l0E0^#iC[扏WRu]fzywL&᷷jP9*Xm1h؉N+gz[,cEOP\qu` KԯOܼh!eGFpL\qsz@Ԃ[BK_BjճMYټl* jng /dp!b`9+!u,]a+09UD6VNfJt4ڽs?6- hH5|l߾Y<6B1R&iD1ЙylD39$WQrv&8^xj潠W>kGcO(vsdǫ q ~) fu!~is2lHn9E$(CF t:芕(h \y}'8:So̬nP0,@o̲:+^ zw޹v]j5CUh'|q[2lKMTᡌ\".6lU̓^D܍xWb=ʼn)V~ז6(b͔8Oy\puZB+w]`% fr2 U*BB㖖oeA|9=o dU;X]o"j :7 \ϔ/3R%>߉ ˡ {Q?3-#ja(ZӬ-[BvQF1M^!C"!+LӎoC%+=vqݴArhH-C$>#+Vvw.$# D,/_d 0;.VMA6C5sZ{{%SLRc.OLVRM81# N'ك;'J4jwPqlFGa3V+/_;76,n*Tf6Txw{\R(8-4uh]w^(g >w2аEpIS pNN K03c6wa$޳Zh;4]4uA* AX!߱2&];oԅ 5R'+@gf!v;zbMpc)0HFVӗ6-an{?,4>mR9~nzۯ58$VdeW#!jK0FwsbN'laәByBdv>"KcBfFμnoQ _Y0Nh!Ⱥd4<@6V!(Iw/)U=8 zښ3{qB|}WW[3/; IHfyEUyD}f@dM~N- *i[m,zn|Ei\܏x*- b4x)ߍ.Hk;$©S$Ǫ/&џc=5J^׈YCqN̈!)n'<%Lת>9Ɨ*7oRӮ"~nD{4zghӦT)7I`=߳?u_Zǚ(?{V"~cQ?읦R%6T`yCFo:d7]yMo/2юhFORF%[5< }2`O~U޹š)˦{0:b,F˙*jrE=2?# {o3h.FpzIm%NU8]YrqPʌZid@g߆X&ӻͮBhJfz:p6؉;'c#WWE ͸Ÿ]rCs㔭PKY2_EUÒ}`lѼb H@hpY-$iv0y4FrI"2 nxUefT9 |޵ӯ9("X>Q H'L!ޤDJ  fbqdҭ,i/13JX[ޭ! t <ci7Xu=*Ku~?6:gv%R:9o$` a)=bu@W/ Nw,M*jHhtI/!?j};D9cP -svv| 8$GD XIJSCy/cE2OjiTaɂ@:Eͣ#To@DbT秴!ȇKX4;",7|w ɽV\p;(z3[e  ugu>EnVvOuӳfYD9qC퓳x@< wd )$TMɎct_&@$[n;%t'4'Tti@\ҭ`.AMv9_y4,X8&i)#yL\dxRbS& Ft(1IW'>6x7|7R_:ʈ'}eS >4jԣ/^iE7Bڂ@|{˙^1p4rVSYҪwɠ؍*i]!w΄=BˆX (~<>ӽ)!xxX ׬Fӄ,q+ٟEknAH8'*FH[ߎ G'H[S0Lv<1nUPo&¬@p7(ȗ7ѬCF8:-==c*ڪ Z9?/6 F|~_7f/+ ^䝕ew"*R%HGhccgbIl\$jd?NMߐ7 b pbeQpv3e14)دȪ*)ݪyj.5VcBDee2 ѕ=`#?8i_Td` ˼o*[@+t,i6~+ t.Pcd/[{ (bDzϡBar!REz\q? YOV E?j\df["_yi?T$IQ}'ٻ4ז\8dy)vYenAN!LA{=ie!:ggyQܵ!$',!:rb},RO3L㘥`cZl*AE?{wO?Jyd=X jWf:ѡ"z*QT4vӂET);I֍%bԮ'-5Dy;WWs-"BK0Ӑ/bHWVofuYm5FxjCVLZ6K ~_c xLpWԁX kW|ءlG!lo#!TL*5- 'j欆$4a[3;lqչ50sW6;qY6ٖr['e }$loS͍Z $hZMg<_Slp"҇eM+!5>Q.cfU9E?rIA]-^Jk+HO\78?&VG_I !*U/!,y-+FUMb1e/!iok _-G am *B9js8PД;4gk2}y5>"2t_+Pi!rѽoHOF[Hē8" aF47O V.3xZJ|QXڨ%SUUx c0Gm0)% /6+c`W&N>o 3TwP]n9,L&jW :?>b$x] Di5Bn)֏b½gcl+&8 砥nIYr#`6rVJgevL  `To4b!Q:Hl5JWu`^H=3%j[ro@\"-Uu~zh~݂".e0Q웷S[᜽| #aP#Ͱ*Q!`m42_/w(8+8MVzkux{Szj9`JYHL[WM3z8W9=4műƨ .of9\ZoXP|k-PܹJ qU UܦP'bѫN)CJ 5Nh}PckY6C`frz!OHOaj8a=cP/نdפ?G9N@FڪO\}lI9q%b*z\ ?jޜ#oHmF9~7O']הcU-Kzfߨw`pNKs,rN+n. ˘3ng y7^BB kl8rmO,ڠH}xًBx`.ݡ~y$uR[)7^5܃b$p&cLnD8&vU&"jm9]9l a@rܟCe1Q +6 ]4^/x́&(PpKh<ٗ0W?HDDž!N0=Gt gH ^`'W`N Lb"I; 2 \ǐTVtCfP4d2tay"r nA=3N-^-8 *ws_`n68\v5% T&.޳١{ ^+I\:km :>^W';'_Ĵ24H^\ G\m$Ԛx 8_B^ӭ."T"FFfZә\E֛tgiW+{a%E6:!w V}Cgd#/7"r|*/_;78;ž4㥐ʷ0֪BBrv^%֔ւTgJFkcT7~Ē\'y1{@K )F"Ц}'uαk1GzaZrqb:Vѧ!*ZՒ(=&EYOK®+)8)9tB?ʀ"-A]-$>ôEVw.cMqU8et0_j٧c͒CIq,m6֓EN+tqi+ "ap"D7{nB)Gn)5Jl\:*=CX-JbJD`E* ؊rv%='揩dІ1 /Ю?pjA0Ѝ8 w0] ToOӊ4 2,ZT+jŞ_y:xmEk.:oT-x߰92k0ylX=eX9)naGknkEȝAM}-ȌEt>Ps66.^#4"io@)$2KM5%@Yھ֖p\`oKk$O&.'W|cwA\ǹN(2 F G|b4{ljDINx5Fg./ʼno's:v+\'_Z?!^{w50rap Qnʼ]S_ M|NӂR۳`;Tk5yߠ3JTXpFFNrVZ㢖\H"#Mf~0%FҭFC:ݙ'r2/e~qHvxsQ D`uv?4Rhoiao“Xta%Nd's4" P_0a]*IـzT=˖KoW(@$|ASBnUw#e8:j.uު'v"f92-c=K!0eZ#eH45waKRE,MF?*&&nE6Rz6At(S&`,.$3:|vLSByR"52_]s_nf27ZL P{eAIy^ѧm5"DO8OyOn-C#:mUÔ\-P/M[8"dļxe?S ذ|+ht̗=nݫnLXok.,b=:E)C:﹀V%7}i()QJ[z]oBd:7~?ǝc?0 TX J̒aaꭰTG$TT@ ZlDu}/qPC=ԗT 5xj˧ r.*!875||=ĐZRlFLR EQ)n**K# ^%{Ee|407g4K42A o=CEcܘbē̏dB7"Ҋ Wƚ;A%M}y:/+jk] @!.p]PyTfN^L{ sr 5x͑]R&GX_BIfT[N𹎾׸w}ɘ c1,Zv5^Ѳ~c9wyTeb=?S_}_vgD[lT@HQ86 VkYBv<j{jk=Hufy6 [HYK5Cِ p3! 9njtFQ!'&{J rjY|Q $>{7QpCl\hN_J|Oqa JHͻQ!G,Y :`"xq 暴8K$ D2Fw RA'_~7E!рF@TKKo#.^ Դô~7zYږg"!3俄6Ya&_\ꏏIX Wlzt})|=oIEprMj~]^._XNip>n9?ye VBud@fϱS=bHYoi)y,ߗ f&:Z=%Xwbs e/'Yd MyQH2Դ[m)t0׬z2P#C$a#hj*N3>~gXqT0gK?tg %,J} nRTܦo;-]Wn~ig3 TT N+涨su!SV(oC/Bz_C%*=p 4L<"h\x}֣jP}cM$SM,:43`"-`c #)͸ac`cFK%B{7;y Z*nwҋe݃E:܏$zj̋Wb v'm,GQuu޶#ӣ?Kr mJ~qo`5cOՐSƗXHjPax) /)!r2 Jީ%dI >H] z?3Y}e6cu>鰮}EX6 Y"?OˤZC'-,GZ)%3Fǖ|t;F(\rCHT6b?YVU! vt(~yaġ'$˴AeC 7rcV6;?mP\ "9̯&ͥ]*`HLq$ ~[)AqӍ=Xy+CsGK7oY//Ujw?3b`zsgԔ?a$aApU1ߛc pPЁdZxoyۜ0 V|W5bu"*>&KUk}r^9dCXs{nOxc զї!F`hNgiX/49lD^Xց*KB{rNwLirkw2.zCamײQ%_I7./NU[..Õ]ߒA ,F#k,s:^թȴd/^$lz)3 :KWEt\UY~6?&據@ԼWͨr68FgRPb"VȩOy 飀D+AF6iWd(M)Q fwp*?D f}0b-P3_52=_-!q1A@z]Q}wh Qv`F"V4] Z6BSr3=/ D f8)Y]~(35ќdϛ~9OvW n}C66t,LL󩼼ncS0njm39KGhȮ9󜾕gdM㦴ǖMBi.L'ɖdSJo^bKK0ߢq ?!:2/US  };qp3``- mʟlc VmŏrhI][@z\IetQ&APr pS}GկUVLͷJhOc2pRC:Q.~sy!4GL)C*07'8ICVPG]ڝeF ^K"1NbئZpC& =J 1SGVV{&aSIޱ$@M Ih i9%)N Ű?<;Ej5-?bS0|)66afX$(ԕ|#SUޟ^7S=T5NBEڅ3aiG6N`р=J•qGhEmguzZN(z`'r*C{FwSS!(a7NVQ10Yӗ& )_{6K{cns+^W|P[h3wzdY[G~=}Ht+cDB/ZdH8ч晟R Vb:5R't0 YZfPortfolio/man/0000755000175100001440000000000013201353173013164 5ustar hornikusersfPortfolio/man/portfolio-getDefault.Rd0000644000175100001440000000367613630670372017577 0ustar hornikusers\name{portfolio-getDefault} \alias{getDefault} \alias{getConstraints} \alias{getControl} \alias{getCov} \alias{getCovRiskBudgets} \alias{getData} \alias{getEstimator} \alias{getMean} \alias{getMu} \alias{getUnits} \alias{getModel} \alias{getNAssets} \alias{getNFrontierPoints} \alias{getObjective} \alias{getOptim} \alias{getOptions} \alias{getOptimize} \alias{getPortfolio} \alias{getParams} \alias{getRiskFreeRate} \alias{getSeries} \alias{getSigma} \alias{getSolver} \alias{getSpec} \alias{getStatistics} \alias{getStatus} \alias{getAlpha} \alias{getTailRisk} \alias{getTailRiskBudgets} \alias{getTargetReturn} \alias{getTargetRisk} \alias{getTrace} \alias{getType} \alias{getWeights} \title{Extractor Functions} \description{ Extractor functions to get information from objects of class fPFOLIODATA, fPFOLIOSPEC, fPFOLIODATA, fPFOLIOVAL, and fPORTFOLIO. } \usage{ getConstraints(object) getControl(object) getCov(object) getCovRiskBudgets(object) getData(object) getEstimator(object) getMean(object) getMu(object) getNAssets(object) getNFrontierPoints(object) getObjective(object) getOptim(object) getOptions(object) getOptimize(object) getPortfolio(object) getParams(object) getRiskFreeRate(object) getSeries(object) getSigma(object) getSolver(object) getSpec(object) getStatistics(object) getStatus(object) getAlpha(object) getTailRisk(object) getTailRiskBudgets(object) getTargetReturn(object) getTargetRisk(object) getTrace(object) getType(object) getWeights(object) } \arguments{ \item{object}{ an object of class \code{fPFOLIODATA}, \code{fPFOLIOSPEC} or \code{fPORTFOLIO}. } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/a-class-fPFOLIOVAL.Rd0000644000175100001440000000113412323217772016504 0ustar hornikusers\name{fPFOLIOVAL} \alias{fPFOLIOVAL} \alias{class-fPFOLIOVAL} \alias{fPFOLIOVAL-class} \alias{show,fPFOLIOVAL-method} \title{Values of Portfolio Frontiers} \description{ Specifies portfolio Optimized Values. } \usage{ \S4method{show}{fPFOLIOVAL}(object) } \arguments{ \item{object}{ an S4 object of class \code{fPFOLIOVAL}. } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/backtest-plots.Rd0000644000175100001440000000717012330665056016427 0ustar hornikusers\name{backtest-plots} \alias{backtestPlot} \alias{backtestAssetsPlot} \alias{backtestWeightsPlot} \alias{backtestRebalancePlot} \alias{backtestPortfolioPlot} \alias{backtestDrawdownPlot} \alias{backtestReportPlot} \title{Portfolio backtesting plots} \description{ Creates and displays plots of cumulative assets returns, of portfolio weights, of rebalanced weights, of drawdowns and of a report summary for backtesting. } \usage{ % We should add a generic plot function for objects of class smoothed % portfolios. DW % backtestPlot(object, which="all", labels=TRUE, legend=TRUE, at=NULL, format=NULL, cex=0.6, font=1, family="mono") backtestAssetsPlot(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) backtestWeightsPlot(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) backtestRebalancePlot(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) backtestPortfolioPlot(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) backtestDrawdownPlot(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) backtestReportPlot(object, cex=0.6, font=1, family="mono") } \arguments{ \item{object}{ a list, returned from running the function \code{portfolioSmoothing}. } \item{which}{ an integer or string value. If the argument is an integer then it specifies which backtest plot should be displayed. If the argument take the character value \code{all}, which is the default, then all 6 available backtest plots will be displayed. } \item{labels}{ a logical flag, determining if the graph should be labeled automatically. This is the default case \code{labels=TRUE}. If set to \code{FALSE} then the graph will be displayed undecorated and the user can it decorate by himself. } \item{legend}{ a logical flag, determining if to the graph a legend should be added. This is the default case \code{labels=TRUE}. If set to \code{FALSE} then the graph will be displayed undecorated and the user can it decorate by himself. } \item{at}{ if NULL the time-axis ticks will be selected automatically. If \code{at} is a vector of \code{timeData} character formatted dates then the axis ticks ar taken from this vector. } \item{format}{ if NULL the time-axis ticks are labeled automatically. If \code{format} is a POSIX format string, tthen the label formats are taken from this string. } \item{cex, font, family}{ font size, font and font family specification for the report. } } \details{ These backtest plot summarises the results obtained from portfolio backtesting. The function \code{backtestAssetsPlot} displays the set of possible assets to construct a portfolio. The function \code{backtestWeightsPlot} displays the recommended weights for investment. The function \code{backtestRebalancePlot} displays the weight changes over time for individual assets and for the portfolio. The function \code{backtestPortfolioPlot} displays the daily, benchmark and portfolio series of a portfolio backtest. The function \code{backtestDrawdownPlot} displays the daily drawdowns for the benchmark and the portfolio. The function \code{backtestReportPlot} summarises the results from a portfolio backtest. } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-Frontier.Rd0000644000175100001440000000462012323217772017270 0ustar hornikusers\name{portfolio-portfolioFrontier} \alias{portfolioFrontier} \title{Efficient Portfolio Frontier} \description{ Compoutes the efficient portfolio frontier. } \usage{ portfolioFrontier(data, spec = portfolioSpec(), constraints = "LongOnly", include.mvl = TRUE, title = NULL, description = NULL) } \arguments{ \item{constraints}{ a character string vector, containing the constraints of the form\cr \code{"minW[asset]=percentage"} for box constraints resp. \cr \code{"maxsumW[assets]=percentage"} for sector constraints. } \item{data}{ a multivariate time series described by an S4 object of class \code{timeSeries}. If your timeSerie is not a \code{timeSeries} object, consult the generic function \code{as.timeSeries} to convert your time series. } \item{description}{ a character string which allows for a brief description. } \item{include.mvl}{ a logical flag, should the minimum variance locus be added to the plot? } \item{spec}{ an S4 object of class \code{fPFOLIOSPEC} as returned by the function \code{portfolioSpec}. } \item{title}{ a character string which allows for a project title. } } \details{ \bold{Portfolio Frontier:} \cr\cr The function \code{portfolioFrontier} calculates the whole efficient frontier. The portfolio information consists of five arguments: data, specifications, constraints, title and description. The range of the frontier is determined from the range of the asset returns, and the number of equidistant points in the returns, is calculated from the number of frontier points hold in the specifrication structure. To extract or to modify the number of frontier points use the functions \code{getNFrontierPoints} and \code{setNFrontierPoints}. The \code{frontierPortfolio} function returns the properties of the the efficient frontier as an S4 object of class \code{fPORTFOLIO}. } \value{ \code{portfolioFrontier} function returns an S4 object of class \code{"fPORTFOLIO"}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-Rolling.Rd0000644000175100001440000000773412323217772017117 0ustar hornikusers\name{portfolio-rollingPortfolios} \alias{portfolioRolling} \alias{rollingPortfolio} \alias{rollingWindows} \alias{rollingCmlPortfolio} \alias{rollingTangencyPortfolio} \alias{rollingMinvariancePortfolio} \alias{rollingPortfolioFrontier} \title{Rolling Portfolio} \description{ A collection and description of functions allowing to roll a portfolio optimization over time. The functions are: \tabular{ll}{ \code{rollingWindows} \tab Returns a list of rolling window frames, \cr \code{rollingCmlPortfolio} \tab Rolls a CML portfolio, \cr \code{rollingTangencyPortfolio} \tab Rolls a tangency portfolio, \cr \code{rollingMinvariancePortfolio} \tab Rolls a minimum risk portfolio, \cr \code{rollingPortfolioFrontier} \tab returns an efficient portfolio} } \usage{ rollingWindows(x, period = "12m", by = "1m") rollingCmlPortfolio(data, spec, constraints, from, to, action = NULL, title = NULL, description = NULL, \dots) rollingTangencyPortfolio(data, spec, constraints, from, to, action = NULL, title = NULL, description = NULL, \dots) rollingMinvariancePortfolio(data, spec, constraints, from, to, action = NULL, title = NULL, description = NULL, \dots) rollingPortfolioFrontier(data, spec, constraints, from, to, action = NULL, title = NULL, description = NULL, \dots) } \arguments{ \item{action}{ a character string naming a user defined function. This function is optionally applied after each rolling step. } \item{by}{ a character string, by default \code{"1m"}, which denotes 1 month. The shift by which the portfolio is rolled. } \item{constraints}{ a character string vector, containing the constraints of the form\cr \code{"minW[asset]=percentage"} for box constraints resp. \cr \code{"maxsumW[assets]=percentage"} for sector constraints. } \item{data}{ a list, having a statistics named list, having named entries 'mu' and 'Sigma', containing the information of the statistics. } \item{description}{ a character string, allowing for a brief project description, by default NULL, i.e. Date and User. } \item{from, to}{ a vector of S4 \code{timeDate} objects which denote the starting and ending dates for the investigation. } \item{period}{ a character string, by default \code{"12m"}, which denotes 12 months. The period over which the portfolio is rolled. } \item{spec}{ an S4 object of class \code{fPFOLIOSPEC}. } \item{title}{ a character string, containing the title for the object, by default NULL. } \item{x}{ an S4 object of class \code{timeSeries} from which the rolling window frames will be created. The length of these frames is given by the argument \code{period} and they are shifted by the value specified by the argument \code{by}. } \item{\dots}{ optional arguments to be passed.\cr } } \details{ \bold{RollingWindows:} The function \code{rollingWindows} constructs from a 'timeSeries' object windows frames of given length \code{period} and shift \code{by}. ... \cr \bold{Rolling Portfolios:} \cr\cr The functions \code{rolling*Portfolio} ... \cr \bold{Rolling Frontier:} \cr\cr The function \code{rollingPortfolioFrontier} ... } \value{ \code{rollingwindows()}\cr returns ... \cr \code{rollingCmlPortfolio}\cr \code{rollingTangencyPortfolio}\cr \code{rollingMinvariancePortfolio}\cr return ... \cr \code{rollingPortfolioFrontier}\cr returns ... \cr } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/backtest-getMethods.Rd0000644000175100001440000000322212323217772017363 0ustar hornikusers\name{backtest-getMethods} \alias{getWindows} \alias{getWindowsFun} \alias{getWindowsParams} \alias{getWindowsHorizon} \alias{getStrategy} \alias{getStrategyFun} \alias{getStrategyParams} \alias{getSmoother} \alias{getSmootherFun} \alias{getSmootherParams} \alias{getSmootherLambda} \alias{getSmootherDoubleSmoothing} \alias{getSmootherInitialWeights} \alias{getSmootherSkip} %\alias{getMessages} Already defined in fPortfolio \title{Portfolio Backtest Extractors} \description{ Extractor functions to get information from objects of class fPFOLIOBACKTEST. } \arguments{ \item{object}{ an object of class \code{fPFOLIOBACKTEST} as returned by function \code{portfolioBacktest}. } } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \examples{ ## portfolioBacktest Specification - backtestSpec = portfolioBacktest() backtestSpec ## Extract Windows Information - getWindows(backtestSpec) getWindowsFun(backtestSpec) getWindowsParams(backtestSpec) getWindowsHorizon(backtestSpec) ## Extract Strategy Information - getStrategy(backtestSpec) getStrategyFun(backtestSpec) getStrategyParams(backtestSpec) ## Extract Smoother Information - getSmoother(backtestSpec) getSmootherFun(backtestSpec) getSmootherParams(backtestSpec) getSmootherLambda(backtestSpec) getSmootherDoubleSmoothing(backtestSpec) getSmootherInitialWeights(backtestSpec) getSmootherSkip(backtestSpec) } \keyword{models} fPortfolio/man/portfolio-covEstimator.Rd0000644000175100001440000000642412323217772020163 0ustar hornikusers\name{portfolio-covEstimator} \alias{covEstimator} \alias{mveEstimator} \alias{mcdEstimator} \alias{lpmEstimator} \alias{slpmEstimator} \alias{kendallEstimator} \alias{spearmanEstimator} \alias{covMcdEstimator} \alias{covOGKEstimator} \alias{shrinkEstimator} \alias{nnveEstimator} \title{Covariance Estimators} \description{ Functions to estimate and robustify the sample mean and covariance of rectangular objects. } \usage{ covEstimator(x, spec = NULL, \dots) mveEstimator(x, spec = NULL, \dots) mcdEstimator(x, spec = NULL, \dots) lpmEstimator(x, spec = NULL, \dots) slpmEstimator(x, spec = NULL, \dots) kendallEstimator(x, spec = NULL, \dots) spearmanEstimator(x, spec = NULL, \dots) covMcdEstimator(x, spec = NULL, \dots) covOGKEstimator(x, spec = NULL, \dots) shrinkEstimator(x, spec = NULL, \dots) nnveEstimator(x, spec = NULL, \dots) } \arguments{ \item{x}{ an object of class \code{timeSeries}. } \item{spec}{ unused, may be used to pass information from the portfolio specification object to the mean and covariance estimator function. } \item{\dots}{ optional arguments to be passed to the underlying estimators. } } \value{ the functions return a list with two entries named \code{mu} and \code{Sigma}. The first denotes the vector of column means, and the second the covariance matrix. Note, that the output of this function can be used as data input for the portfolio functions to compute the efficient frontier. } \details{ The functions are underlying the following algorithms:\cr \code{covEstimator} uses standard covariance estimation,\cr \code{mveEstimator} uses the function "cov.mve" from the MASS package,\cr \code{mcdEstimator} uses the function "cov.mcd" from the MASS package,\cr \code{lpmEstimator} returns lower partial moment estimator,\cr \code{kendallEstimator} returns Kendall's rank estimator,\cr \code{spearmanEstimator} returns Spearman's rankestimator,\cr \code{covMcdEstimator} requires "covMcd" from package robustbase,\cr \code{covOGKEstimator} requires "covOGK" from package robustbase,\cr \code{nnveEstimator} uses builtin from package covRobust,\cr \code{shrinkEstimator} uses builtin from package corpcor. } \references{ Breiman L. (1996); \emph{Bagging Predictors}, Machine Learning 24, 123--140. Ledoit O., Wolf. M. (2003); \emph{ImprovedEestimation of the Covariance Matrix of Stock Returns with an Application to Portfolio Selection}, Journal of Empirical Finance 10, 503--621. Schaefer J., Strimmer K. (2005); \emph{A Shrinkage Approach to Large-Scale Covariance Estimation and Implications for Functional Genomics}, Statist. Appl. Genet. Mol. Biol. 4, 32. Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \author{ ... for R's \code{MASS} package, \cr ... for R's \code{robustbase} package, \cr ... for R's \code{covRobust} package, \cr Juliane Schaefer and Korbinian Strimmer for R's \code{corpcor} package, \cr Diethelm Wuertz for this Rmetrics port. } \keyword{models} fPortfolio/man/a-class-fPORTFOLIO.Rd0000644000175100001440000002376612323217772016545 0ustar hornikusers\name{fPORTFOLIO} \alias{fPORTFOLIO} \alias{class-fPORTFOLIO} \alias{fPORTFOLIO-class} \alias{plot.fPORTFOLIO} \alias{summary.fPORTFOLIO} \title{Portfolio Class} \description{ A collection and description of functions allowing to gain information about optimal portfolios. Generally, optimization is done via three arguments, data, specification of the portfolio, and constraints, while function portfolioFrontier has two additional arguments for title and description. } \usage{ \method{plot}{fPORTFOLIO}(x, which = "ask", control = list(), \dots) \method{summary}{fPORTFOLIO}(object, \dots) } \arguments{ \item{control}{ a list, defining the plotting parameters. The list modifies amongst others the color, e.g. \code{minvariance.col}, type of point, e.g. \code{tangency.pch}, or the dimension of the point, e.g. \code{cml.cex}, see Notes for a complete list of control parameters. } \item{which}{ which of the plots should be displayed? \code{which} can be either a character string, \code{"all"} (displays all plots) or \code{"ask"} (interactively asks which one to display), or a vector of integer values displaying the corresponding plot. Default value is \code{"ask"}. } \item{object, x}{ an S4 object of class \code{fPORTFOLIO}. } \item{\dots}{ optional arguments to be passed.\cr } } \details{ \bold{Portfolio Class:} \cr\cr This S4 class contains all information about the portfolio. Basically these are risk measure, mean and covariance estimation, target return, risk free rate, number of frontier points, ranges for calculation, see the "Value" section for a detailed description of the slots. } \value{ \code{portfolioFrontier()}\cr returns an S4 object of class \code{"fPORTFOLIO"}, with the following slots: \item{@call}{ a call, returning the matched function call. } \item{@data}{ a list with two named elements, \code{series} holding the time series data if available, otherwise NA, and \code{statistics}, itself a named list with two named elements \code{mu} and \code{Sigma} holding the vector of means and the matrix of covariances. } \item{@description}{ a character string, allowing for a brief project description. } \item{@portfolio}{ a list, containing parameter specifications for the portfolio:\cr \code{weights} a numeric vector specifying the portfolio weights,\cr \code{targetReturn} a numeric value specifying the target return,\cr \code{targetRisk} a numeric value specifying the target risk,\cr \code{targetMean} a numeric value specifying the target return determinated with function mean(),\cr \code{targetStdev} a numeric value specifying the target risk in standart deviation as risk measure. } \item{@specification}{ a list with one named element \code{spec} which represents an object of class \code{fPFOLIOSPEC}, including all information about the portfolio specifications, see \code{PortfolioSpec} for further details. } \item{@title}{ a title string. } \code{feasiblePortfolio}\cr \code{cmlPortfolio}\cr \code{tangencyPortfolio}\cr \code{minvariancePortfolio}\cr \code{efficientPortfolio}\cr return an S4 object of class \code{fPORTFOLIO} having information only about one portfolio. } \section{Control Parameters}{ In the following all elements of argument control from functions \code{plot}, \code{weightsSlider}, \code{frontierSlider} are listed. \describe{ \item{sliderResolution}{ [weightsSlider, frontierSlider] - a numeric, determining the numbers of slider points, by default nFrontierPoints/10. } \item{sliderFlag}{ [weightsSlider, frontierSlider] - a character string, denoting the slidertype, by default "frontier" for \code{frontierSlider} and "weights" for \code{weightsSlider}. } \item{sharpeRatio.col}{ [plot, frontierSlider] - a character string, defining color of the Sharpe ratio plot, by default "black". } \item{minvariance.col}{ a character string, defining color of the minimum variance portfolio, by default "red". } \item{tangency.col}{ a character string, defining color of the tangency portfolio, by default "steelblue". } \item{cml.col}{ [plot, frontierSlider] - a character string, defining color of the market portfolio and the capital market line, by default "green". } \item{equalWeights.col}{ [plot, frontierSlider] - a character string, defining the color of the equal weights portfolio, by default "blue". } \item{runningPoint.col}{ [weightsSlider] - a character string, defining color of the point indicating the current portfolio, by default "red". } \item{singleAsset.col}{ a character string vector, defining color of the single asset portfolios. The vector must have length the number of assets, by default \code{rainbow}. } \item{twoAssets.col}{ [plot, frontierSlider] - a character string, defining color of the two assets efficient frontier, by default "grey". } \item{monteCarlo.col}{ [plot, frontierSlider] - a character string, defining color of the Monte Carlo portfolios, by default "black". } \item{minvariance.pch}{ a number, defining symbol used for the minimum variance portfolio. See \code{\link{points}} for description. Default symbol is 17. } \item{tangency.pch}{ a number, defining symbol used for the tangency portfolio. See \code{\link{points}} for description. Default symbol is 17. } \item{cml.pch}{ [plot, frontierSlider] - a number, defining symbol used for the market portfolio. See \code{\link{points}} for description. Default symbol is 17. } \item{equalWeights.pch}{ [plot, frontierSlider] - a number, defining symbol used for the equal weights portfolio. See \code{\link{points}} for description. Default symbol is 15. } \item{singleAsset.pch}{ a number, defining symbol used for the single asset portfolios. See \code{\link{points}} for description. Default symbol is 18. } \item{sharpeRatio.cex}{ [plot, frontierSlider] - a number, determining size (percentage) of the Sharpe ratio plot, by default 0.1. } \item{minvariance.cex}{ a number, determining size (percentage) of the minimum variance portfolio symbol, by default 1. } \item{tangency.cex}{ a number, determining size (percentage) of the tangency portfolio symbol, by default 1.25. } \item{cml.cex}{ [plot, frontierSlider] - a number, determining size (percentage) of the market portfolio symbol, by default 1.25. } \item{equalWeights.cex}{ [plot, frontierSlider] - a number, determining size (percentage) of the equal weights portfolio symbol, by default 0.8. } \item{runningPoint.cex}{ [weightsSlider] - a number, determining size (percentage) of the point indicating the current portfolio equal weights portfolio symbol, by default 0.8. } \item{singleAsset.cex}{ a number, determining size (percentage) of the singel asset portfolio symbols, by default 0.8. } \item{twoAssets.cex}{ [plot, frontierSlider] - a number, determining size (percentage) of the two assets efficient frontier plot, by default 0.01. } \item{monteCarlo.cex}{ [plot, frontierSlider] - a number, determining size (percentage) of the Monte Carol portfolio symbols, by default 0.01. } \item{monteCarlo.cex}{ [plot, frontierSlider] - a number, determining size (percentage) of the Monte Carol portfolio symbols, by default 0.01. } \item{mcSteps}{ [plot] - a number, determining number of Monte Carol portfolio, by default 5000. } \item{pieR}{ [plot, frontierSlider] - a vector, containing factors for shrinking and stretching the x- and y-axis, by default NULL, i.e. c(1, 1) is used. Default pie size is 1/15 of the plot range. } \item{piePos}{ [plot, frontierSlider] - a number, determining the weight on the efficient frontier, which is illustrated by the pie. Default is tangency portfolio } \item{pieOffset}{ [plot, frontierSlider] - a vector, containing the pie's x- and y-axis offset from the efficient frontier. Default is NULL, i.e. the pie is set one default radius left of the efficient frontier. } \item{xlim}{ [weightsSlider, frontierSlider] - a vector, containing x-axis plot limits of the efficient frontier. Default setting is maximum of frontier range or single assets portfolios. } \item{ylim}{ [weightsSlider, frontierSlider] - a vector, containing y-axis plot limits of the efficient frontier. Default setting is maximum of frontier range or single assets portfolios. } } % end describe } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/utils-methods.Rd0000644000175100001440000000075012323217772016266 0ustar hornikusers\name{utils-methods} \alias{print.solver} \title{Print Method for Solvers} \description{ S3 print method for mathematical programming solvers. } \usage{ \method{print}{solver}(x, \dots) } \arguments{ \item{x}{x} \item{\dots}{optional arguments} } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/frontier-Points.Rd0000644000175100001440000000344212323217772016570 0ustar hornikusers\name{frontier-points} \alias{frontierPoints} \title{Get Frontier Points} \description{ Extracts the risk and return coordinates of the efficient frontier. } \usage{ frontierPoints(object, frontier = c("both", "lower", "upper"), return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE) } \arguments{ \item{object}{ an object of class \code{fPORTFOLIO}. } \item{frontier}{ a character string denoting which part of the efficient portfolio should be extractacted. } \item{return}{ character strings denoting which return measure should be plotted. Allowed values for the return are either \code{"mean"}, or \code{"mu"}. } \item{risk}{ character strings denoting which risk measure should be plotted. Allowed values for the risk measure are either \code{"cov"}, \code{"sigma"}, \code{"VaR"}, or \code{"CVaR"}. } \item{auto}{ a logical flag. If \code{auto} is \code{TRUE}, the default setting, then the risk willbe identified automatically from the object. } } \details{ The automated risk detection, \code{auto=TRUE} takes the following decision: \preformatted{ if (auto) { Type = getType(object) Estimator = getEstimator(object) if (Type == "MV") risk = "cov" if (Type == "MV" & Estimator != "covEstimator") risk = "sigma" if (Type == "QLPM") risk = "sigma" if (Type == "CVaR") risk = "CVaR" } } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/a-class-fPFOLIOBACKTEST.Rd0000644000175100001440000000342612323217772017270 0ustar hornikusers\name{fPFOLIOBACKTEST} \alias{fPFOLIOBACKTEST} \alias{class-fPFOLIOBACKTEST} \alias{fPFOLIOBACKTEST-class} \alias{show,fPFOLIOBACKTEST-method} \title{Portfolio backtesting specifications} \description{ Specifies portfolio backtesting objects. } \usage{ \S4method{show}{fPFOLIOBACKTEST}(object) } \arguments{ \item{object}{ an S4 object of class \code{fPFOLIOBACKTEST}. } } \details{ \bold{Portfolio Backtest Specification:} \cr\cr The S4 class \code{fPFOLIOBACKTEST} specifies portfolio backtesting. The slots are:\cr \describe{ \item{@windows}{ a list, setting the \code{windows} function that defines the rolling windows, and the set of window specific parameters \code{params}. E.g The window horizon is set as a parameter \code{horizon = "24m"} } \item{@strategy}{ a list, setting the portfolio \code{strategy} to implement during the backtest, and any strategy specific parameters are found in \code{params}. } \item{@smoother}{ a list, specifying the smoothing style, given as a \code{smoother} function, and any smoother specific parameters are stored in the list \code{params}. } \item{@messages}{ a list, any messages collected during the backtest} } } \value{ \code{portfolioBacktest} returns an S4 object of class \code{"fPFOLIOBACKTEST"}. } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/methods-plot.Rd0000644000175100001440000000047712323217772016112 0ustar hornikusers\name{methods-plot} \alias{plot-methods} \title{plot-methods} \description{ plot-methods. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/backtest-performance.Rd0000644000175100001440000000165612323217772017572 0ustar hornikusers\name{backtest-performance} \alias{netPerformance} \title{Portfolio backtesting net performance} \description{ Displays plot of rebased portfolio performance and summary statistics. } \usage{ netPerformance(object, format = "\%Y-\%m-\%d") } \arguments{ \item{object}{ a list, returned from running the function \code{portfolioSmoothing}. } \item{format}{ a character string of the date format used } } \value{ A plot of rebased portfolio returns and tables summarising portfolio performance over time. } \note{ This function will become obsolete by functions provided in the upcoming \code{fPortfolioPerformance} package. } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/00fPortfolio-package.Rd0000644000175100001440000000161513203340725017333 0ustar hornikusers\name{fPortfolio-package} \alias{fPortfolio} \docType{package} \title{Portfolio Design, Optimization and Backtesting} \description{ The Rmetrics "fPortfolio" package is a very powerful collection of functions to optimize portfolios and to analyze them from different points of view. } \details{ \tabular{ll}{ Package: \tab fPortfolio\cr Type: \tab Package\cr Date: \tab 2011\cr License: \tab GPL Version 2 or later\cr Copyright: \tab (c) 1999-2011 Diethelm Wuertz and Rmetrics Association\cr URL: \tab \url{http://www.rmetrics.org} } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/frontier-Plot.Rd0000644000175100001440000001345312323217772016235 0ustar hornikusers\name{frontier-plot} \alias{frontierPlot} \alias{minvariancePoints} \alias{cmlPoints} \alias{cmlLines} \alias{tangencyPoints} \alias{tangencyLines} \alias{equalWeightsPoints} \alias{singleAssetPoints} \alias{twoAssetsLines} \alias{sharpeRatioLines} \alias{monteCarloPoints} \alias{tailoredFrontierPlot} \title{Efficient Frontier Plot} \description{ Plots the efficient frontier of an optimized portfolio and allows to add points and lines from specif portfolios } \usage{ frontierPlot(object, frontier = c("both", "lower", "upper"), col = c("black", "grey"), add = FALSE, labels = TRUE, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, title = TRUE, \dots) minvariancePoints(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) cmlPoints(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) cmlLines(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) tangencyPoints(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) tangencyLines(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) equalWeightsPoints(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) singleAssetPoints(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) twoAssetsLines(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) sharpeRatioLines(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) monteCarloPoints(object, mcSteps = 5000, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, \dots) tailoredFrontierPlot(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), mText = NULL, col = NULL, xlim = NULL, ylim = NULL, twoAssets = FALSE, sharpeRatio = TRUE, title = TRUE, \dots) } \arguments{ \item{object}{ an S4 object of class \code{fPORTFOLIO}, containing slots call, data, specification, constraints, portfolio, title, description. } \item{frontier}{ a character string, determining which part of the frontier should be extracted. \code{"both"} stands for the full hyperbola, \code{"lower"} for all points below the minimum variance return and \code{"upper"} for the actual efficient frontier, by default "both". } \item{col}{ a character string vector, setting the color. For \code{frontierPlot} it is a two dimensional a vector; first entry is the upper part of the frontier,\cr second entry the lower, by default "black" and "grey".\cr For the other functions the argument defines the color representation, by default sets the default color is the rainbow palette. } \item{add}{ a logical value, determining whether the frontier should be added to an existing plot, by default FALSE. } \item{return}{ a character string denoting which type of return should be plotted. Allowed values for the return are either \code{"mean"}, or \code{"mu"}. } \item{risk}{ a character string denoting which type of risk should be plotted. Allowed values for the risk measure are either \code{"cov"}, \code{"sigma"}, \code{"VaR"}, or \code{"CVaR"}. } \item{auto}{ a logical flag denoting if the type of return and risk to be plotted should be selected automatically, by default TRUE. } \item{labels}{ a logical flag, should the plot be automatically labeled and decorated? By default \code{TRUE}. } \item{title}{ a logical flag, should the plot obtain a default main title and x- and y-labels? By default \code{TRUE}. } \item{mcSteps}{ an integer value, the number of Monte Carlo steps. } \item{xlim, ylim}{ two numeric vectors with two elelemts , the plot range. If set to NULL the values for the plot ranges are determined automatically. } \item{mText}{ a character string, representing a marginal text string. If set to NULL the value is taken from the title of the input frontier argument. } \item{twoAssets}{ a logical flag, if TRUE, then the two assets frontier lines will be drawn. } \item{sharpeRatio}{ a logical flag, if TRUE, then the Sharpe ratio will be added to the plot. } \item{\dots}{ optional arguments to be passed. } } \details{ \tabular{ll}{ \code{frontierPlot} \tab Plots efficient frontier, \cr \code{minvariancePoints} \tab Adds minimum variance point, \cr \code{cmlPoints} \tab Adds market portfolio, \cr \code{cmlLines} \tab Adds capital market Line, \cr \code{tangencyPoints} \tab Adds tangency portfolio point, \cr \code{tangencyLines} \tab Adds tangency line, \cr \code{equalWeightsPoints} \tab Adds point of equal weights portfolio, \cr \code{singleAssetPoints} \tab Adds points of single asset portfolios, \cr \code{twoAssetsLines} \tab Adds EF for all combinations of two assets, \cr \code{sharpeRatioLines} \tab Adds Sharpe ratio line, \cr \code{monteCarloPoints} \tab Adds randomly produced feasible portfolios, \cr \code{tailoredFrontierPlot} \tab an example for a tailored plot. } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/backtest-statisitics.Rd0000644000175100001440000000311112323217772017620 0ustar hornikusers\name{backtestStats} \alias{backtestStats} \alias{rollingSigma} \alias{rollingVaR} \alias{rollingCVaR} \alias{rollingDaR} \alias{rollingCDaR} \alias{rollingRiskBudgets} \title{Rolling portfolio backtesting statistics} \description{ Computes rolling statistics for backtest analysis } \usage{ backtestStats(object, FUN = "rollingSigma", \dots) rollingSigma(object) rollingVaR(object) rollingCVaR(object) rollingDaR(object) rollingCDaR(object) } \arguments{ \item{object}{ a list, returned from running the function \code{portfolioSmoothing}. } \item{FUN}{ a character string, specifying the name of the rolling statistics function. } \item{\dots}{ optional argument to be passed to the rolling statistics function \code{FUN}. } } \details{ The function \code{rollingSigma} calculates the portfolio risk, Sigma, over time. The function \code{rollingVaR} calculates a rolling Value at Risk. The function \code{rollingCVaR} calculates a rolling Conditional Value at Risk. The function \code{rollingDaR} calculates a rolling Drawdowns at Risk. The function \code{rollingCDaR} calculates a rolling Conditional Drawdowns at Risk. %The function \code{rollingRiskBudgets} calculates a rolling Risk %Budget of the portfolio. } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/a-class-fPFOLIODATA.Rd0000644000175100001440000000565012323217772016602 0ustar hornikusers\name{fPFOLIODATA} \alias{fPFOLIODATA} \alias{class-fPFOLIODATA} \alias{fPFOLIODATA-class} \alias{show,fPFOLIODATA-method} \alias{portfolioData} \title{Portfolio Data Handling} \description{ Creates a fPFOLIODATA object with data set and statistical measures. } \usage{ portfolioData(data, spec = portfolioSpec()) \S4method{show}{fPFOLIODATA}(object) } \arguments{ \item{data}{ [portfolioStatistics] - \cr a time series or a named list, containing either a series of returns or named entries 'mu' and 'Sigma' being mean and covariance matrix. } \item{object}{ [show] - \cr an object of class \code{fPFOLIODATA} as returned by the function \code{portfolioData}. } \item{spec}{ an S4 object of class \code{fPFOLIOSPEC}, the specification to be modified, by default the default of the function \code{portfolioSpec()}. } } \details{ \bold{Dutch Portfolio Data Set:} \cr\cr This data represents seven stocks from the Dutch AEX index, Netherlands blue chips. The data is a list of the covariance matrix and the return means and is based on daily returns over a period from January 1990 till end of October 2003. Companies representing the data are Elsevier, Fortis, Getronics, Heineken, Philips, Shell and Unilever. \cr \bold{US Portfolio Data Set:} \cr\cr The data inherits eight assets being indexes, commodities and bonds. The data is a time series of yearly returns from December 1973 till December 1994. Assets are TBills3m, LongBonds, SP500, Wilshire5000, NASDAQComp, LehmanBonds, EAFE, Gold. \cr \bold{Simulated Mean-Cov Data Set:} \cr\cr This data is taken from chapter 1.3.2 in Scherer, M., Martin, R.D. (2005); \emph{Introduction To Modern Portfolio Optimization with NuOPT, S-PLUS and S+Bayes}, Springer, Berlin. It is a list of covariance matrix and the return means of imaginary assets. It is an example set for learning about optimization. \cr \bold{World Index Returns Data Set:} \cr\cr This data set is contributed by D. Locher (2007); It is a timeSeries object of four world index return data sets including Asia, Eastern Europe, Far East and Latin America. } \value{ \code{portfolioStatistics}\cr returns a named list of estimated mean \code{$mu} and covariance \code{$Sigma} statistics, from a multivariate time series of assets. \cr \code{portfolioData}\cr returns a named list of the time series \code{$series} and the portfolio \code{$statistics} as returned by the function \code{portfolioStatistics}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/backtest-portfolios.Rd0000644000175100001440000000314612323217772017465 0ustar hornikusers\name{backtest-portfolio} \alias{portfolioBacktesting} \alias{portfolioSmoothing} \title{Portfolio backtesting} \description{ Tests a portfolio by a rolling backtest. } \usage{ portfolioBacktesting(formula, data, spec = portfolioSpec(), constraints = "LongOnly", backtest = portfolioBacktest(), trace = TRUE) portfolioSmoothing(object, backtest, trace = TRUE) } \arguments{ \item{formula}{ a formula describing the benchmark and assets used for backtesting in the form \code{backtest ~ assetA + ... + assetZ}. Here, \code{backtest} and \code{asset*} are column names of the \code{data} set. } \item{data}{ an object of class \code{timeSeries}. } \item{spec}{ an S4 object of class \code{fPFOLIOSPEC} as returned by the function \code{portfolioSpec}. } \item{constraints}{ a character string value or vector defining the constraints, for details we refer to \code{portfolioConstraints}. } \item{backtest}{ an S4 object of class \code{fPFOLIOBACKTEST} as returned by the function \code{portfolioBacktest}. } \item{object}{ a list as returned by the function \code{portfolioBacktesting}. } \item{trace}{ a logical flag, by default TRUE. Should the backtersting be traced? } } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/weights-piePlots.Rd0000644000175100001440000000677212323217772016746 0ustar hornikusers\name{weights-piePlot} \alias{weightsPie} \alias{weightedReturnsPie} \alias{covRiskBudgetsPie} \alias{tailRiskBudgetsPie} \title{Portfolio Pie Plots} \description{ Displays pie plots of weights, weighted Returns, covariance and tail risk budgets for a portfolio. } \usage{ weightsPie(object, pos = NULL, labels = TRUE, col = NULL, box = TRUE, legend = TRUE, radius = 0.8, \dots) weightedReturnsPie(object, pos = NULL, labels = TRUE, col = NULL, box = TRUE, legend = TRUE, radius = 0.8, \dots) covRiskBudgetsPie(object, pos = NULL, labels = TRUE, col = NULL, box = TRUE, legend = TRUE, radius = 0.8, \dots) tailRiskBudgetsPie(object, pos = NULL, labels = TRUE, col = NULL, box = TRUE, legend = TRUE, radius = 0.8, \dots) } \arguments{ \item{object}{ an S4 object of class \code{fPORTFOLIO}, as returned by one of the portfolio functions, e.g. \code{efficientPortfolio} or \code{portfolioFrontier}. } \item{pos}{ NULL or an integer value. If NULL it is assumend that we consider a single portfolio like for example a tengency portfolio. However, if the \code{object} describes a whole frontier then \code{pos} has to be the number of that point from the frontier which we want to display. The frontier points are numbered from one up to the value give by the number of frontier points, which can be retrieved by calling \code{getNFrontierPoints}. } \item{labels}{ a logical flag, determining if the graph should be labeled automatically, which is the default case \code{labels=TRUE}. If set to \code{FALSE} then the graph will be displayed undecorated and the user can it decorate by himself. Evenmore, if \code{labels} takes the value of a string vector, then the names of the assets from the porftolio \code{object} will be ignored, and the labels will be taken from the specified string vector. } \item{col}{ a character string vector, defined from a color palette. The default setting uses the "Blues" \code{seqPalette} palette. } \item{box}{ a logical flag, determining whether a boxed frame should be plotted around the pie, by default the value is set to \code{TRUE}. } \item{legend}{ a logical flag, determining if a legend should be added to the plot. The default setting shows the legend. } \item{radius}{ a numeric value, determining the radius of the pie. The default value is 0.8. } \item{\dots}{ arguments to be passed. } } \details{ The pie plots allow for different views on the results obtained from a feasible or an optimized portfolio. The function \code{weightsPie} displays the weights composition of a portfolio. The function \code{weightedReturnsPie} displays the investment, i.e. the weighted returns of a portfolio. The function \code{covRiskBudgetsPie} displays the covariance risk budgets of a portfolio. The function \code{taikRiskBudgetsPie} displays the copulae tail risk budgets of a portfolio. Note, this is only possible if in the portfolio specificsation a copulae tail risk is defined. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/methods-summary.Rd0000644000175100001440000000051312323217772016620 0ustar hornikusers\name{methods-summary} \alias{summary-methods} \title{summary-methods} \description{ summary-methods. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/solver-ampl.Rd0000644000175100001440000000303112323217772015721 0ustar hornikusers\name{solver-ampl} \alias{amplModelOpen} \alias{amplModelAdd} \alias{amplModelShow} \alias{amplDataOpen} \alias{amplDataAdd} \alias{amplDataAddValue} \alias{amplDataAddVector} \alias{amplDataAddMatrix} \alias{amplDataSemicolon} \alias{amplDataShow} \alias{amplRunOpen} \alias{amplRunAdd} \alias{amplRunShow} \alias{amplOutShow} \title{AMPL Interface} \description{ R/AMPL Interface functions. } \usage{ amplModelOpen(project) amplModelAdd(model, project) amplModelShow(project) amplDataOpen(project) amplDataAdd(name, data, type, project) amplDataAddValue(data, value, project) amplDataAddVector(data, vector, project) amplDataAddMatrix(data, matrix, project) amplDataSemicolon(project) amplDataShow(project) amplRunOpen(project) amplRunAdd(run, project) amplRunShow(project) amplOutShow(project) } \arguments{ \item{project}{ a character string, the AMPL project name. } \item{model}{...} \item{data}{...} \item{run}{...} \item{type}{...} \item{name}{...} \item{value}{...} \item{vector}{...} \item{matrix}{...} } \value{ returns AMPL files. } \author{ Diethelm Wuertz. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{optim} fPortfolio/man/backtest-specification.Rd0000644000175100001440000000263112323217772020103 0ustar hornikusers\name{backtest-specification} \alias{portfolioBacktest} \title{Specification of portfolio backtesting} \description{ Specifies how the portfolio backtesting is performed. } \usage{ portfolioBacktest( windows = list( windows = "equidistWindows", params = list(horizon = "12m")), strategy = list( strategy = "tangencyStrategy", params = list()), smoother = list( smoother = "emaSmoother", params = list(doubleSmoothing = TRUE, lambda = "3m", skip = 0, initialWeights = NULL)), messages = list()) } \arguments{ \item{windows}{ a list, containing different arguments: windows, params (horizon). } \item{strategy}{ a list, containing different arguments: strategy, params. } \item{smoother}{ a list, containing different arguments: smoother, params. (doubleSmoothing, lambda, skip, initialWeights). } \item{messages}{ a list containing the backtesting messages. } } \value{ returns an S4 object of class \code{"fPFOLIOBACKTEST"}. } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/methods-show.Rd0000644000175100001440000000077012323217772016110 0ustar hornikusers\name{methods-show} \alias{show-methods} \alias{show,fPORTFOLIO-method} \title{Portfolio Print Methods} \description{ show-methods. } \usage{ \S4method{show}{fPORTFOLIO}(object) } \arguments{ \item{object}{ an S4 object of class \code{fPORTFOLIO}. } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/weights-barPlots.Rd0000644000175100001440000000714712323217772016732 0ustar hornikusers\name{weightsPlot} \alias{weightsPlot} \alias{weightedReturnsPlot} \alias{covRiskBudgetsPlot} \alias{tailRiskBudgetsPlot} \alias{riskBudgetsPlot} \title{Portfolio Weights Bar Plots} \description{ Displays plots of weights, investments, covariance and tail risk budgets. } \usage{ weightsPlot(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) weightedReturnsPlot(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) covRiskBudgetsPlot(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) tailRiskBudgetsPlot(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) riskBudgetsPlot(object, FUN=c("budgetsNormalVAR","budgetsNormalES", "budgetsModifiedVAR","budgetsModifiedES", "budgetsSampleCOV"), labels = TRUE, col = NULL, title = TRUE, mtext = TRUE, box = TRUE, legend = TRUE, ...) } \arguments{ \item{object}{ an S4 object of class \code{fPORTFOLIO}, as returned by one of the portfolio functions, e.g. \code{efficientPortfolio} or \code{portfolioFrontier}. } \item{labels}{ a logical flag, determining if the the graph should be labeled automatically, which is the default case \code{labels=TRUE}. If set to \code{FALSE} then the graph will be displayed undecorated and the user can it decorate by himself. } \item{col}{ a character string vector, defined from a color palette. The default setting uses the "Blues" \code{seqPalette} palette. } \item{title}{ a logical flag. Should automatically a title and axis labels be added to the plot. } \item{box}{ a logical flag, determining whether a boxed frame should be plotted around the pie, by default the value is set to \code{TRUE}. } \item{legend}{ a logical value, determining if the the graph should be labeled automatically, shich is the default case \code{labels=TRUE}. If set to \code{FALSE} then the graph will be displayed undecorated and the user can it decorate by himself. Evenmore, if \code{labels} takes the value of a string vector, then the names of the assets from the porftolio \code{object} will be ignored, and the labels will be taken from the specified string vector. } \item{\dots}{ additional arguments passed to the function \code{barplot}. Only active if \code{labels=FALSE}. } \item{FUN}{FUN} \item{mtext}{mtext} } \details{ These barplots plots allow for different views on the results obtained from a feasible or an optimized portfolio. The function \code{weightsPlot} displays the weights composition along the frontier of a portfolio. The function \code{weightedReturnsPlot} displays the investment composition, i.e. the weighted returns along the frontier of a portfolio. The function \code{covRiskBudgetsPlot} displays the covariance risk budgets composition along the frontier of a portfolio. The function \code{tailRiskBudgetsPlot} displays the copulae tail risk budgets composition along the frontier of a portfolio. Note, this is only possible if in the portfolio specificsation a copulae tail risk is defined. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/frontier-PlotControl.Rd0000644000175100001440000000445412323217772017577 0ustar hornikusers\name{frontier-plotControl} \alias{frontierPlotControl} \title{Frontier Plot Control List} \description{ Allows to modify plot settings for the frontier plot. } \usage{ frontierPlotControl( # Colors: sharpeRatio.col = "blue", minvariance.col = "red", tangency.col = "steelblue", cml.col = "green", equalWeights.col = "blue", singleAsset.col = "topo.colors", twoAssets.col = "grey", monteCarlo.col = "black", # Point Sizes: minvariance.cex = 1.25, tangency.cex = 1.25, cml.cex = 1.25, equalWeights.cex = 1.25, singleAsset.cex = 1.25, twoAssets.cex = 0.01, monteCarlo.cex = 0.01, sharpeRatio.cex = 0.1, # Limits: xlim = NULL, ylim = NULL, # MC Steps: mcSteps = 5000, # Pie Settings: pieR = NULL, piePos = NULL, pieOffset = NULL) } \arguments{ \item{sharpeRatio.col}{Color setting.} \item{minvariance.col}{Color setting.} \item{tangency.col}{Color setting.} \item{cml.col}{Color setting.} \item{equalWeights.col}{Color setting.} \item{singleAsset.col}{Color setting.} \item{twoAssets.col}{Color setting.} \item{monteCarlo.col}{Color setting.} \item{minvariance.cex}{Font point size setting.} \item{tangency.cex}{Font point size setting.} \item{cml.cex}{Font point size setting.} \item{equalWeights.cex}{Font point size setting.} \item{singleAsset.cex}{Font point size setting.} \item{twoAssets.cex}{Font point size setting.} \item{monteCarlo.cex}{Font point size setting.} \item{sharpeRatio.cex}{Font point size setting.} \item{xlim}{x-axis limit setting.} \item{ylim}{y-axis limit setting.} \item{mcSteps}{Numer of Monte Carlo steps.} \item{pieR}{Pie radius setting.} \item{piePos}{Pie position coordinates setting.} \item{pieOffset}{Pie offset coordinates setting.} } %\details{} \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/backtest-constructors.Rd0000644000175100001440000000533112323217772020033 0ustar hornikusers\name{backtest-constructors} \alias{setBacktest} \alias{setWindowsFun<-} \alias{setWindowsParams<-} \alias{setWindowsHorizon<-} \alias{setStrategyFun<-} \alias{setStrategyParams<-} \alias{setSmootherFun<-} \alias{setSmootherParams<-} \alias{setSmootherLambda<-} \alias{setSmootherDoubleSmoothing<-} \alias{setSmootherInitialWeights<-} \alias{setSmootherSkip<-} \title{Specification of backtesting portfolios} \description{ Functions to set specifications for portfolio backtesting. \cr The functions are: \tabular{ll}{ \code{setWindowsFun} \tab Sets Windows function, \cr \code{setWindowsParams} \tab Sets additional parameters for rolling windows function, \cr \code{setWindowsHorizon} \tab Sets Windows horizon, \cr \code{setStrategyFun} \tab Sets the portfolio Strategy function, \cr \code{setStrategyParams} \tab Sets additional parameters for Strategy function, \cr \code{setSmootherFun} \tab Sets the Smoother function, \cr \code{setSmootherParams} \tab Sets additional parameters for Smoother function, \cr \code{setSmootherLambda} \tab Sets the smoothing parameter Lambda, \cr \code{setSmootherDoubleSmoothing} \tab Sets setting for double smoothing, \cr \code{setSmootherInitialWeights} \tab Sets the initial weights to used in the smoothing, \cr \code{setSmootherSkip} \tab Sets the number of skipped months. } } \usage{ setWindowsFun(backtest) <- value setWindowsParams(backtest) <- value setWindowsHorizon(backtest) <- value setStrategyFun(backtest) <- value setStrategyParams(backtest) <- value setSmootherFun(backtest) <- value setSmootherParams(backtest) <- value setSmootherLambda(backtest) <- value setSmootherDoubleSmoothing(backtest) <- value setSmootherInitialWeights(backtest) <- value setSmootherSkip(backtest) <- value } \arguments{ \item{backtest}{ an S4 object of class \code{fPFOLIOBACKTEST}, the specification to be modified, by default the default of the function \code{portfolioBacktest()}. } \item{value}{ a value for that component of \code{backtest} to be set. Note for setting Params value is a list. } } \details{ The function \code{portfolioBacktest()} allows to set the values for the specification structure from scratch. To modify individual settings one can use the set functions. } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-getPortfolio.Rd0000644000175100001440000001062112424415406020147 0ustar hornikusers\name{portfolio-getPortfolio} \alias{getData.fPORTFOLIO} \alias{getSeries.fPORTFOLIO} \alias{getNAssets.fPORTFOLIO} \alias{getUnits.fPORTFOLIO} \alias{getStatistics.fPORTFOLIO} \alias{getMean.fPORTFOLIO} \alias{getCov.fPORTFOLIO} \alias{getMu.fPORTFOLIO} \alias{getSigma.fPORTFOLIO} \alias{getEstimator.fPORTFOLIO} \alias{getSpec.fPORTFOLIO} \alias{getModel.fPORTFOLIO} \alias{getType.fPORTFOLIO} \alias{getOptimize.fPORTFOLIO} \alias{getEstimator.fPORTFOLIO} \alias{getTailRisk.fPORTFOLIO} \alias{getParams.fPORTFOLIO} \alias{getOptim.fPORTFOLIO} \alias{getSolver.fPORTFOLIO} \alias{getTrace.fPORTFOLIO} \alias{getConstraints.fPORTFOLIO} \alias{getConstraintsTypes} \alias{getPortfolio.fPORTFOLIO} \alias{getWeights.fPORTFOLIO} \alias{getTargetReturn.fPORTFOLIO} \alias{getTargetRisk.fPORTFOLIO} \alias{getAlpha.fPORTFOLIO} \alias{getRiskFreeRate.fPORTFOLIO} \alias{getNFrontierPoints.fPORTFOLIO} \alias{getStatus.fPORTFOLIO} \alias{getCovRiskBudgets.fPORTFOLIO} \alias{getTailRiskBudgets.fPORTFOLIO} \alias{getA.fPORTFOLIO} \alias{getControl.fPORTFOLIO} \alias{getObjective.fPORTFOLIO} \alias{getOptions.fPORTFOLIO} \title{Portfolio Class Extractors} \description{ A collection and description of functions allowing to get information about an object of class fPORTFOLIO. \cr The functions are: \tabular{ll}{ \code{getData} \tab Extracts ..., \cr \code{getSeries} \tab Extracts ..., \cr \code{getStatistics} \tab Extracts ..., \cr \code{getNAssets} \tab Extracts ..., \cr \code{getSpec} \tab Extracts ..., \cr \code{getType} \tab Extracts ..., \cr \code{getEstimator} \tab Extracts ..., \cr \code{getParams} \tab Extracts ..., \cr \code{getSolver} \tab Extracts ..., \cr \code{getTrace} \tab Extracts ..., \cr \code{getConstraints} \tab Extracts ..., \cr \code{getPortfolio} \tab Extracts ..., \cr \code{getWeights} \tab Extracts ..., \cr \code{getTargetReturn} \tab Extracts ..., \cr \code{getTargetRisk} \tab Extracts ..., \cr \code{getAlpha} \tab Extracts ..., \cr \code{getRiskFreeRate} \tab Extracts ..., \cr \code{getNFrontierPoints} \tab Extracts ..., \cr \code{getStatus} \tab Extracts ..., \cr \code{getCovRiskBudgets} \tab Extracts ..., \cr \code{getTailRiskBudgets} \tab Extracts ... . } } \usage{ \method{getData}{fPORTFOLIO}(object) \method{getSeries}{fPORTFOLIO}(object) \method{getNAssets}{fPORTFOLIO}(object) \method{getUnits}{fPORTFOLIO}(x) \method{getStatistics}{fPORTFOLIO}(object) \method{getMean}{fPORTFOLIO}(object) \method{getCov}{fPORTFOLIO}(object) \method{getMu}{fPORTFOLIO}(object) \method{getSigma}{fPORTFOLIO}(object) \method{getEstimator}{fPORTFOLIO}(object) \method{getSpec}{fPORTFOLIO}(object) \method{getModel}{fPORTFOLIO}(object) \method{getType}{fPORTFOLIO}(object) \method{getOptimize}{fPORTFOLIO}(object) \method{getEstimator}{fPORTFOLIO}(object) \method{getTailRisk}{fPORTFOLIO}(object) \method{getParams}{fPORTFOLIO}(object) \method{getOptim}{fPORTFOLIO}(object) \method{getSolver}{fPORTFOLIO}(object) \method{getTrace}{fPORTFOLIO}(object) \method{getConstraints}{fPORTFOLIO}(object) \method{getPortfolio}{fPORTFOLIO}(object) \method{getWeights}{fPORTFOLIO}(object) \method{getTargetReturn}{fPORTFOLIO}(object) \method{getTargetRisk}{fPORTFOLIO}(object) \method{getAlpha}{fPORTFOLIO}(object) \method{getRiskFreeRate}{fPORTFOLIO}(object) \method{getNFrontierPoints}{fPORTFOLIO}(object) \method{getStatus}{fPORTFOLIO}(object) \method{getCovRiskBudgets}{fPORTFOLIO}(object) \method{getTailRiskBudgets}{fPORTFOLIO}(object) \method{getA}{fPORTFOLIO}(object) \method{getControl}{fPORTFOLIO}(object) \method{getObjective}{fPORTFOLIO}(object) \method{getOptions}{fPORTFOLIO}(object) } \arguments{ \item{object}{ an object of class \code{fPORTFOLIO}, containing slots call, data, specification, constraints, portfolio, title, description. } \item{x}{ an object of class \code{fPORTFOLIO}, containing slots call, data, specification, constraints, portfolio, title, description. } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/weights-Slider.Rd0000644000175100001440000001602712323217772016363 0ustar hornikusers\name{weights-Slider} \alias{weightsSlider} \title{Portfolio Weights Slider} \description{ Interactive portfolio weights plot. } \usage{ weightsSlider(object, control = list(), \dots) } \arguments{ \item{control}{ a list, defining the plotting parameters. The list modifies amongst others the color, e.g. \code{minvariance.col}, type of point, e.g. \code{tangency.pch}, or the dimension of the point, e.g. \code{cml.cex}, see Notes for a complete list of control parameters. } \item{object}{ an S4 object of class \code{fPORTFOLIO}. } \item{\dots}{ optional arguments to be passed. } } \details{ The slider has illustrative objectives. The function expects an S4 object of class \code{fPORTFOLIO}. The weights slider gives an overview of the weights on the efficient frontier. Three weight plots \code{weightsPlot}, \code{piePlot} and the not stacked weights and a frontier plot with the single assets, the tangency portfolio and a legend are provided. In the two weights plots the vertical line indicates the current portfolio and a dotted one indicates the minimum variance portfolio. The number in the pie plot stands for the asset and the sign shows whether this asset is short or long. In all plots colors represent the same asset. } \value{ Creates interactive plots. } \section{Control Parameters}{ In the following all elements of argument control from functions \code{plot}, \code{weightsSlider}, \code{frontierSlider} are listed. \describe{ \item{sliderResolution}{ a numeric, determining the numbers of slider points, by default nFrontierPoints/10. } \item{sliderFlag}{ a character string, denoting the slidertype, by default "frontier" for \code{frontierSlider} and "weights" for \code{weightsSlider}. } \item{sharpeRatio.col}{ a character string, defining color of the Sharpe ratio plot, by default "black". } \item{minvariance.col}{ a character string, defining color of the minimum variance portfolio, by default "red". } \item{tangency.col}{ a character string, defining color of the tangency portfolio, by default "steelblue". } \item{cml.col}{ a character string, defining color of the market portfolio and the capital market line, by default "green". } \item{equalWeights.col}{ a character string, defining the color of the equal weights portfolio, by default "blue". } \item{runningPoint.col}{ a character string, defining color of the point indicating the current portfolio, by default "red". } \item{singleAsset.col}{ a character string vector, defining color of the single asset portfolios. The vector must have length the number of assets, by default \code{rainbow}. } \item{twoAssets.col}{ a character string, defining color of the two assets efficient frontier, by default "grey". } \item{monteCarlo.col}{ a character string, defining color of the Monte Carlo portfolios, by default "black". } \item{minvariance.pch}{ a number, defining symbol used for the minimum variance portfolio. See \code{\link{points}} for description. Default symbol is 17. } \item{tangency.pch}{ a number, defining symbol used for the tangency portfolio. See \code{\link{points}} for description. Default symbol is 17. } \item{cml.pch}{ a number, defining symbol used for the market portfolio. See \code{\link{points}} for description. Default symbol is 17. } \item{equalWeights.pch}{ a number, defining symbol used for the equal weights portfolio. See \code{\link{points}} for description. Default symbol is 15. } \item{singleAsset.pch}{ a number, defining symbol used for the single asset portfolios. See \code{\link{points}} for description. Default symbol is 18. } \item{sharpeRatio.cex}{ a number, determining size (percentage) of the Sharpe ratio plot, by default 0.1. } \item{minvariance.cex}{ a number, determining size (percentage) of the minimum variance portfolio symbol, by default 1. } \item{tangency.cex}{ a number, determining size (percentage) of the tangency portfolio symbol, by default 1.25. } \item{cml.cex}{ a number, determining size (percentage) of the market portfolio symbol, by default 1.25. } \item{equalWeights.cex}{ a number, determining size (percentage) of the equal weights portfolio symbol, by default 0.8. } \item{runningPoint.cex}{ a number, determining size (percentage) of the point indicating the current portfolio equal weights portfolio symbol, by default 0.8. } \item{singleAsset.cex}{ a number, determining size (percentage) of the singel asset portfolio symbols, by default 0.8. } \item{twoAssets.cex}{ a number, determining size (percentage) of the two assets efficient frontier plot, by default 0.01. } \item{monteCarlo.cex}{ a number, determining size (percentage) of the Monte Carol portfolio symbols, by default 0.01. } \item{monteCarlo.cex}{ a number, determining size (percentage) of the Monte Carol portfolio symbols, by default 0.01. } \item{mcSteps}{ a number, determining number of Monte Carol portfolio, by default 5000. } \item{pieR}{ a vector, containing factors for shrinking and stretching the x- and y-axis, by default NULL, i.e. c(1, 1) is used. Default pie size is 1/15 of the plot range. } \item{piePos}{ a number, determining the weight on the efficient frontier, which is illustrated by the pie. Default is tangency portfolio } \item{pieOffset}{ a vector, containing the pie's x- and y-axis offset from the efficient frontier. Default is NULL, i.e. the pie is set one default radius left of the efficient frontier. } \item{xlim}{ a vector, containing x-axis plot limits of the efficient frontier. Default setting is maximum of frontier range or single assets portfolios. } \item{ylim}{ a vector, containing y-axis plot limits of the efficient frontier. Default setting is maximum of frontier range or single assets portfolios. } } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-setSpec.Rd0000644000175100001440000000721312323217772017107 0ustar hornikusers\name{portfolio-setSpec} \alias{setSpec} \alias{setType<-} \alias{setOptimize<-} \alias{setEstimator<-} \alias{setTailRisk<-} \alias{setParams<-} \alias{setAlpha<-} \alias{setWeights<-} \alias{setTargetReturn<-} \alias{setTargetRisk<-} \alias{setRiskFreeRate<-} \alias{setNFrontierPoints<-} \alias{setStatus<-} \alias{setSolver<-} \alias{setObjective<-} \alias{setTrace<-} %\alias{maxReturn} %\alias{minRisk} \title{Settings for Specifications of Portfolios} \description{ Functions to set specifications for a portfolio. } \usage{ setType(spec) <- value setOptimize(spec) <- value setEstimator(spec) <- value setTailRisk(spec) <- value setParams(spec, name) <- value setAlpha(spec) <- value setWeights(spec) <- value setTargetReturn(spec) <- value setTargetRisk(spec) <- value setRiskFreeRate(spec) <- value setNFrontierPoints(spec) <- value setStatus(spec) <- value setSolver(spec) <- value setObjective(spec) <- value setTrace(spec) <- value %maxReturn(x, mu) %minRisk(x, Sigma) } \arguments{ \item{spec}{ an S4 object of class \code{fPFOLIOSPEC}, the specification to be modified, by default the default of the function \code{portfolioSpec()}. } \item{name}{ a character string, the name of the value to be set. } \item{value}{ a value for that component of \code{spec} to be set. } } \details{ \tabular{ll}{ \code{setType} \tab Sets type of portfolio optimization, \cr \code{setOptimize} \tab Sets what to optimize, min risk or max return, \cr \code{setEstimator} \tab Sets names of mean and covariance estimators, \cr \code{setParams} \tab Sets optional model parameters, \cr \code{setWeights} \tab Sets weights vector, \cr \code{setTargetReturn} \tab Sets target return value, \cr \code{setTargetRisk} \tab Sets target risk value, \cr \code{setTargetAlpha} \tab Sets CVaR target alpha value, \cr \code{setRiskFreeRate} \tab Sets risk-free rate value, \cr \code{setNFrontierPoints} \tab Sets number of frontier points, \cr \code{setStatus} \tab Sets status value, \cr \code{setSolver} \tab Sets the type of solver to be used, \cr \code{setObjective} \tab Sets objective function name to be used, \cr \code{setTrace} \tab Sets the logical trace flag. } %\code{maxReturn} \tab Defines the default maximum return function, \cr %\code{minRisk} \tab Defines the default minimum risk function. } } \value{ \code{setType}\cr \code{setOptimize}\cr \code{setEstimator}\cr \code{setParam}\cr \cr \emph{Model Settings:} just modify the model settings including the portfolio type, the mean/covariance estimator, and optional parameters of an existing portfolio structure. \cr \code{setWeights}\cr \code{setTargetReturn}\cr \code{setTargetRisk}\cr \code{setTargetAlpha}\cr \code{setRiskFreeRate}\cr \code{setNFrontierPoints}\cr \code{setStatus}\cr \cr \emph{Portfolio Settings:} just modify the portfolio settings including predefined weights, the target return, the risk free rate, the number of frontier points, and the return and risk range of an existing portfolio structure. \cr \code{setSolver}\cr \code{setObjective}\cr \code{setTrace}\cr \cr \emph{Optim Settings:} just modifies the solver setting, i.e. the type of solver to be used for portfolio optimization. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/risk-ternaryMap.Rd0000644000175100001440000000166712323217772016565 0ustar hornikusers\name{risk-ternaryMap} \alias{ternaryMap} \alias{ternaryFrontier} \alias{riskMap} \alias{maxddMap} \alias{ternaryWeights} \alias{ternaryCoord} \alias{ternaryPoints} \title{Creates and Plots a Ternary Map} \description{ Functions for craeting and plotting ternary maps. } \usage{ ternaryMap(data, FUN=NULL, ..., locator=FALSE, N=41, palette=topo.colors, nlevels=11) ternaryFrontier(data, locator=FALSE) riskMap(data, weights) maxddMap(data, weights) ternaryWeights(n=21) ternaryCoord(weights) ternaryPoints(weights, \dots) } \arguments{ \item{data}{data} \item{weights}{weights} \item{FUN, locator, N, palette, nlevels}{ternaryMap} \item{n}{n} \item{\dots}{optional arguments} } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-pfolioRisk.Rd0000644000175100001440000000152212323217772017617 0ustar hornikusers\name{portfolio-pfolioRisk} \alias{pfolioRisk} \alias{covRisk} \alias{varRisk} \alias{cvarRisk} \title{portfolioRisk} \description{ Computes covariance and CVaR portfolio risk. } \usage{ covRisk(data, weights) varRisk(data, weights, alpha = 0.05) cvarRisk(data, weights, alpha = 0.05) } \arguments{ \item{data}{ a multivariate time series described by an S4 object of class \code{timeSeries}. } \item{weights}{ a numeric vector of weights. } \item{alpha}{ a numeric value, the confidence level, by default \code{alpha=0.05}, i.e. 5\%. } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-feasiblePfolio.Rd0000644000175100001440000000360312323217772020423 0ustar hornikusers\name{portfolio-feasiblePortfolio} \alias{feasiblePortfolio} \title{Feasible Portfolios} \description{ Returns properties of a feasible portfolio. } \usage{ feasiblePortfolio(data, spec = portfolioSpec(), constraints = "LongOnly") } \arguments{ \item{constraints}{ a character string vector, containing the constraints of the form\cr \code{"minW[asset]=percentage"} for box constraints resp. \cr \code{"maxsumW[assets]=percentage"} for sector constraints. } \item{data}{ a multivariate time series described by an S4 object of class \code{timeSeries}. If your timeSerie is not a \code{timeSeries} object, consult the generic function \code{as.timeSeries} to convert your time series. } \item{spec}{ an S4 object of class \code{fPFOLIOSPEC} as returned by the function \code{portfolioSpec}. } } \details{ A feasible portfolio is a portfolio with given weights which lies inside the feasible region of portfolios. The function requires three arguments: \code{data}, \code{spec} (specifications), and \code{constraints}, see above. Be sure that the specification structure \code{"spec"} has defined a weights vector which is different from \code{"NULL"}. To assign values to the weights in the specification structure, use the function \code{setWeights}. The \code{feasiblePortfolio} function returns the properties of the feasible portfolio as an S4 object of class \code{fPORTFOLIO}. } \value{ \code{feasiblePortfolio} function returns an S4 object of class \code{"fPORTFOLIO"}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/backtest-extractors.Rd0000644000175100001440000000631712323217772017466 0ustar hornikusers\name{backtest-extractors} \alias{getWindows.fPFOLIOBACKTEST} \alias{getWindowsFun.fPFOLIOBACKTEST} \alias{getWindowsParams.fPFOLIOBACKTEST} \alias{getWindowsHorizon.fPFOLIOBACKTEST} \alias{getStrategy.fPFOLIOBACKTEST} \alias{getStrategyFun.fPFOLIOBACKTEST} \alias{getStrategyParams.fPFOLIOBACKTEST} \alias{getSmoother.fPFOLIOBACKTEST} \alias{getSmootherFun.fPFOLIOBACKTEST} \alias{getSmootherParams.fPFOLIOBACKTEST} \alias{getSmootherLambda.fPFOLIOBACKTEST} \alias{getSmootherDoubleSmoothing.fPFOLIOBACKTEST} \alias{getSmootherInitialWeights.fPFOLIOBACKTEST} \alias{getSmootherSkip.fPFOLIOBACKTEST} \alias{getMessages.fPFOLIOBACKTEST} \title{Portfolio backtest specification extractors} \description{ Extracts information from an object of class fPFOLIOBACKTEST. \cr The functions are: \tabular{ll}{ \code{getWindows} \tab Extract windows slot, \cr \code{getWindowsFun} \tab extract windows function, \cr \code{getWindowsParams} \tab extract a list of windows specific parameters, \cr \code{getWindowsHorizon} \tab extract windows horizon, \cr \code{getStrategy} \tab extract strategy slot, \cr \code{getStrategyFun} \tab extract the portfolio strategy function, \cr \code{getStrategyParams} \tab extract a list of portfolio strategy specific parameters, \cr \code{getSmoother} \tab extract the smoother slot, \cr \code{getSmootherFun} \tab Extract the Ssoother function, \cr \code{getSmootherParams} \tab extract a list of Smoothing specific parameters, \cr \code{getSmootherLambda} \tab extract the smoothing parameter Lambda, \cr \code{getSmootherDoubleSmoothing} \tab extract setting for double smoothing, \cr \code{getSmootherInitialWeights} \tab extract the initial weights to used in the smoothing, \cr \code{getSmootherSkip} \tab extract the number of skipped months, \cr \code{getMessages} \tab extract the message slot.} } \usage{ \method{getWindows}{fPFOLIOBACKTEST}(object) \method{getWindowsFun}{fPFOLIOBACKTEST}(object) \method{getWindowsParams}{fPFOLIOBACKTEST}(object) \method{getWindowsHorizon}{fPFOLIOBACKTEST}(object) \method{getStrategy}{fPFOLIOBACKTEST}(object) \method{getStrategyFun}{fPFOLIOBACKTEST}(object) \method{getStrategyParams}{fPFOLIOBACKTEST}(object) \method{getSmoother}{fPFOLIOBACKTEST}(object) \method{getSmootherFun}{fPFOLIOBACKTEST}(object) \method{getSmootherParams}{fPFOLIOBACKTEST}(object) \method{getSmootherLambda}{fPFOLIOBACKTEST}(object) \method{getSmootherDoubleSmoothing}{fPFOLIOBACKTEST}(object) \method{getSmootherInitialWeights}{fPFOLIOBACKTEST}(object) \method{getSmootherSkip}{fPFOLIOBACKTEST}(object) \method{getMessages}{fPFOLIOBACKTEST}(object) } \arguments{ \item{object}{ an object of class \code{fPFOLIOBACKTEST} as returned by function \code{portfolioBacktest}. } } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/mathprog-QP.Rd0000644000175100001440000000644112323217772015627 0ustar hornikusers\name{mathprog-QP} \alias{rsolveQP} \alias{rquadprogQP} \alias{quadprogQP} \alias{quadprogQPControl} \alias{rquadprog} \alias{ripopQP} \alias{ipopQP} \alias{ipopQPControl} \alias{ramplQP} \alias{amplQP} \alias{amplQPControl} \alias{rkestrelQP} \alias{kestrelQP} \alias{rneosQP} \alias{neosQP} \alias{kestrelQPControl} \alias{neosQPControl} \title{Mathematical Linear Programming} \description{ Mathematical Quadratic Programming. } \usage{ rsolveQP(objective, lower=0, upper=1, linCons, control=list(solver="quadprog", invoke=c("R", "AMPL", "NEOS"))) rquadprogQP(objective, lower=0, upper=1, linCons, control=list()) quadprogQP(objective=list(dvec=NULL, Dmat=NULL), par.lower=NULL, par.upper=NULL, eqA=NULL, eqA.bound=NULL, ineqA=NULL, ineqA.lower=NULL, ineqA.upper=NULL, control=list()) quadprogQPControl(solver="quadprog", trace=FALSE) rquadprog ripopQP(objective, lower=0, upper=1, linCons, control=list()) ipopQP(objective=list(dvec=NULL, Dmat = NULL), par.lower=NULL, par.upper=NULL, eqA=NULL, eqA.bound=NULL, ineqA=NULL, ineqA.lower=NULL, ineqA.upper=NULL, control=list()) ipopQPControl( sigf=12, maxiter=400, margin=0.05, bound=10, verb=0, inf=1e12, solver="ipop", trace=FALSE) ripop ramplQP(objective, lower=0, upper=1, linCons, control=list()) amplQP(objective=list(dvec=NULL, Dmat=NULL), x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list(), \dots) amplQPControl(solver="ipopt", project="ampl", inf=1e12, trace = FALSE) rkestrelQP(objective, lower=0, upper=1, linCons, control=list()) kestrelQP(objective=list(dvec=NULL, Dmat=NULL), x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list(), \dots) kestrelQPControl(solver="loqo", project="kestrel", inf=1e12, trace = FALSE) rneosQP(objective, lower=0, upper=1, linCons, control=list()) neosQP(objective=list(dvec=NULL, Dmat=NULL), x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list(), \dots) neosQPControl(solver="ipopt", category="nco", project="neos", inf=1e12, trace=FALSE) } \arguments{ \item{objective}{ ... } \item{lower, upper}{ lower and upper bounds. } \item{linCons}{ list of linear constraints: mat, lower, upper. } \item{control}{ control list. } \item{\dots}{ optional arguments to be passed. } \item{par.lower, par.upper}{...} \item{eqA}{...} \item{eqA.bound}{...} \item{ineqA}{...} \item{ineqA.lower,ineqA.upper}{...} \item{x_L,x_U}{...} \item{A}{...} \item{b_L,b_U}{...} \item{solver}{...} \item{category}{...} \item{project}{...} \item{inf}{...} \item{trace}{...} \item{sigf}{...} \item{maxiter}{...} \item{margin}{...} \item{bound}{...} \item{verb}{...} } \value{ a list of class \code{solver} with the following named ebtries: \code{opt}, \code{solution}, \code{objective}, \code{status}, \code{message}, \code{solver}, \code{version}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/mathprog-LP.Rd0000644000175100001440000000505412323217772015621 0ustar hornikusers\name{mathprog-LP} \alias{rsolveLP} \alias{rglpkLP} \alias{glpkLP} \alias{glpkLPControl} \alias{rsymphonyLP} \alias{symphonyLP} \alias{symphonyLPControl} \alias{ramplLP} \alias{amplLP} \alias{amplLPControl} \alias{rneosLP} \alias{neosLP} \alias{neosLPControl} \title{Mathematical Linear Programming} \description{ Mathematical Linear Programming. } \usage{ rsolveLP(objective, lower=0, upper=1, linCons, control=list(solver="glpk", invoke=c("R", "AMPL", "NEOS"))) rglpkLP(objective, lower=0, upper=1, linCons, control=list()) glpkLP glpkLPControl(solver = "glpk", project="r", trace=FALSE) rsymphonyLP(objective, lower=0, upper=1, linCons, control=list()) symphonyLP symphonyLPControl(solver="symphony", project="r", trace=FALSE) ramplLP(objective, lower = 0, upper = 1, linCons, control=list()) amplLP(objective, x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list()) amplLPControl(solver="ipopt", project="ampl", inf=1e12, trace=FALSE) rneosLP(objective, lower = 0, upper = 1, linCons, control=list()) neosLP(objective, x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list()) neosLPControl(solver="ipopt", category="lp", project="neos", inf=1e12, trace=FALSE) } \arguments{ \item{objective}{ a numeric vector. } \item{lower, upper}{ lower and upper bounds. } \item{linCons}{ list of linear constraints: mat, lower, upper. } \item{control}{ control list. } \item{x_L, x_U}{ lower and upper box bounds. } \item{A}{ linear constraints matrix. } \item{b_L, b_U}{ lower and upper linear constraints bounds. } \item{solver}{ a character string, the solver name. } \item{category}{ a character string, the NEOS category name. } \item{project}{ a character string, the AMPL project name. } \item{inf}{ a numeric value, the maximum value used for bounds. } \item{trace}{ a logical flag, if TRUE the optimization will be traced. } } \value{ a list of class \code{solver} with the following named ebtries: \code{opt}, \code{solution}, \code{objective}, \code{status}, \code{message}, \code{solver}, \code{version}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/backtest-functions.Rd0000644000175100001440000000573312323217772017301 0ustar hornikusers\name{backtest-functions} \alias{equidistWindows} \alias{tangencyStrategy} \alias{emaSmoother} \title{User defined functions to perform portfolio backtesting} \description{ Default windows, strategy and smoothing functions used for portfolio backtesting. } \usage{ equidistWindows(data, backtest = portfolioBacktest()) tangencyStrategy(data, spec = portfolioSpec(), constraints = "LongOnly", backtest = portfolioBacktest()) emaSmoother(weights, spec, backtest) } \arguments{ \item{data}{ a multivariate time series described by an S4 object of class \code{timeSeries}. If your timeSerie is not a \code{timeSeries} object, consult the generic function \code{as.timeSeries} to convert your time series. } \item{backtest}{ an S4 object of class \code{fPFOLIOBACKTEST} as returned by the function \code{portfolioBacktest}. } \item{spec}{ an S4 object of class \code{fPFOLIOSPEC} as returned by the function \code{portfolioSpec}. } \item{constraints}{ a character string vector, containing the constraints of the form\cr \code{"minW[asset]=percentage"} for box constraints resp. \cr \code{"maxsumW[assets]=percentage"} for sector constraints. } \item{weights}{ a numeric vector, containing the portfolio weights of an asset } } \details{ \bold{equidistWindows:}\cr Defines equal distant rolling windows. The function requires two arguments: \code{data} and \code{backtest}, see above. To assign the horizon value to the backtest specification structure, use the function \code{setWindowsHorizon}. \bold{tangencyStrategy:}\cr A pre-defined tangency portfolio strategy. The function requires four arguments: \code{data}, \code{spec}, \code{constraints} and \code{backtest}, see above. \bold{emaSmoother:}\cr A pre-defined weights smoother (EMA) for portfolio backtesting. The function requires three arguments: \code{weights}, \code{spec} and \code{backtest}, see above. To assign initial starting weights, smoothing parameter (lambda) or whether to perform double smoothing to the backtest specification structure, use the functions \code{setSmootherInitialWeights}, \code{setSmootherLambda} and \code{setSmootherDoubleSmoothing}, respectively. } \value{ \code{equidistWindows}\cr function returns the "from" and "to" dates of the rolling window in a list form. \code{tangencyStrategy}\cr function returns a S4 object of class \code{"fPORTFOLIO"}. \code{emaSmoother}\cr function returns a numeric vector of smoothed weights. } \references{ W\"urtz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-getVal.Rd0000644000175100001440000000224112323217772016717 0ustar hornikusers\name{portfolio-getVal} \alias{getAlpha.fPFOLIOVAL} \alias{getCovRiskBudgets.fPFOLIOVAL} \alias{getNFrontierPoints.fPFOLIOVAL} \alias{getPortfolio.fPFOLIOVAL} \alias{getRiskFreeRate.fPFOLIOVAL} \alias{getStatus.fPFOLIOVAL} \alias{getTargetReturn.fPFOLIOVAL} \alias{getTargetRisk.fPFOLIOVAL} \alias{getWeights.fPFOLIOVAL} \title{PortfolioVal Extractor Functions} \description{ Extracts information from an object of class fPFOLIOVAL. } \usage{ \method{getAlpha}{fPFOLIOVAL}(object) \method{getCovRiskBudgets}{fPFOLIOVAL}(object) \method{getNFrontierPoints}{fPFOLIOVAL}(object) \method{getPortfolio}{fPFOLIOVAL}(object) \method{getRiskFreeRate}{fPFOLIOVAL}(object) \method{getStatus}{fPFOLIOVAL}(object) \method{getTargetReturn}{fPFOLIOVAL}(object) \method{getTargetRisk}{fPFOLIOVAL}(object) \method{getWeights}{fPFOLIOVAL}(object) } \arguments{ \item{object}{ an object of class \code{fPFOLIODATA}. } } % \details{ % } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/mathprog-NLP.Rd0000644000175100001440000001117513630677255015750 0ustar hornikusers\name{mathprog-NLP} \alias{rdonlp2NLP} \alias{donlp2NLP} \alias{donlp2NLPControl} \alias{rdonlp2} \alias{rsolnpNLP} \alias{solnpNLP} \alias{solnpNLPControl} \alias{rnlminb2NLP} \alias{nlminb2NLP} \alias{nlminb2NLPControl} \alias{rnlminb2} \alias{ramplNLP} \alias{amplNLP} \alias{amplNLPControl} \title{Mathematical Non-Linear Programming} \description{ Mathematical Non-Linear Programming. } \usage{ rdonlp2NLP(start, objective, lower=0, upper=1, linCons, funCons, control=list()) donlp2NLP(start, objective, par.lower=NULL, par.upper=NULL, eqA=NULL, eqA.bound=NULL, ineqA=NULL, ineqA.lower=NULL, ineqA.upper=NULL, eqFun=list(), eqFun.bound=NULL, ineqFun=list(), ineqFun.lower=NULL, ineqFun.upper=NULL, control=list()) donlp2NLPControl( iterma=4000, nstep=20, fnscale=1, report=FALSE, rep.freq=1, tau0=1, tau=0.1, del0=1, epsx=1e-05, delmin=0.1 * del0, epsdif=1e-08, nreset.multiplier=1, difftype=3, epsfcn=1e-16, taubnd=1, hessian=FALSE, te0=TRUE, te1=FALSE, te2=FALSE, te3=FALSE, silent=TRUE, intakt=TRUE) rdonlp2 rsolnpNLP(start, objective, lower=0, upper=1, linCons, funCons, control=list()) solnpNLP(start, objective, par.lower=NULL, par.upper=NULL, eqA=NULL, eqA.bound=NULL, ineqA=NULL, ineqA.lower=NULL, ineqA.upper=NULL, eqFun=list(), eqFun.bound=NULL, ineqFun=list(), ineqFun.lower=NULL, ineqFun.upper=NULL, control=list()) solnpNLPControl( rho=1, outer.iter=400, inner.iter=800, delta=1e-07, tol=1e-08, trace=0) rnlminb2NLP(start, objective, lower=0, upper=1, linCons, funCons, control=list()) nlminb2NLP(start, objective, par.lower=NULL, par.upper=NULL, eqA=NULL, eqA.bound=NULL, ineqA=NULL, ineqA.lower=NULL, ineqA.upper=NULL, eqFun=list(), eqFun.bound=NULL, ineqFun=list(), ineqFun.lower=NULL, ineqFun.upper=NULL, control=list()) nlminb2NLPControl( eval.max=500, iter.max=400, trace=0, abs.tol=1e-20, rel.tol=1e-10, x.tol=1.5e-08, step.min=2.2e-14, scale=1, R=1, beta.tol=1e-20) rnlminb2 ramplNLP(start, objective, lower=0, upper=1, amplCons, control=list(), ...) amplNLP() amplNLPControl( solver="minos", project="ampl", trace=FALSE) } \arguments{ \item{start}{ a numeric vector, the start values. } \item{objective}{ a function object, the function to be optimized. } \item{lower, upper}{ lower and upper bounds. } \item{linCons}{ list of linear constraints: mat, lower, upper. } \item{funCons}{ list of function constraints. } \item{amplCons}{ AMPL constraints. } \item{control}{ control list. } \item{\dots}{ optional arguments to be passed. } \item{par.lower, par.upper}{...} \item{eqA}{...} \item{eqA.bound}{...} \item{ineqA}{...} \item{ineqA.lower,ineqA.upper}{...} \item{eqFun}{...} \item{eqFun.bound}{...} \item{ineqFun}{...} \item{ineqFun.lower,ineqFun.upper}{...} %\item{x_L,x_U}{...} %\item{A}{...} %\item{b_L,b_U}{...} %\item{solver}{...} %\item{category}{...} %\item{project}{...} %\item{inf}{...} %\item{trace}{...} \item{iterma}{4000} \item{nstep}{20} \item{fnscale}{1} \item{report}{FALSE} \item{rep.freq}{1} \item{tau0}{1} \item{tau}{0.1} \item{del0}{1} \item{epsx}{1e-5} \item{delmin}{0.1 * del0} \item{epsdif}{1e-8} \item{nreset.multiplier}{1} \item{difftype}{3} \item{epsfcn}{1e-16} \item{taubnd}{1} \item{hessian}{FALSE} \item{te0}{TRUE} \item{te1}{FALSE} \item{te2}{FALSE} \item{te3}{FALSE} \item{silent}{TRUE} \item{intakt}{TRUE} \item{rho}{1} \item{outer.iter}{400} \item{inner.iter}{800} \item{delta}{1.0e-7} \item{tol}{1.0e-8} %\item{trace}{0} \item{eval.max}{500} \item{iter.max}{400} \item{trace}{0} \item{abs.tol}{1e-20} \item{rel.tol}{1e-10} \item{x.tol}{1.5e-08} \item{step.min}{2.2e-14} \item{scale}{1} \item{R}{1} \item{beta.tol}{1e-20} \item{solver}{solver name} \item{project}{project name} } \value{ a list of class \code{solver} with the following named ebtries: \code{opt}, \code{solution}, \code{objective}, \code{status}, \code{message}, \code{solver}, \code{version}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-portfolioSpec.Rd0000644000175100001440000003361213202334772020330 0ustar hornikusers\name{portfolio-portfolioSpec} \alias{portfolioSpec} \title{Specification of Portfolios} \description{ Specifies a portfolio from scratch. } \usage{ portfolioSpec( model = list( type = "MV", optimize = "minRisk", estimator = "covEstimator", tailRisk = list(), params = list(alpha = 0.05)), portfolio = list( weights = NULL, targetReturn = NULL, targetRisk = NULL, riskFreeRate = 0, nFrontierPoints = 50, status = NA), optim = list( solver = "solveRquadprog", objective = c("portfolioObjective", "portfolioReturn", "portfolioRisk"), options = list(meq = 2), control = list(), trace = FALSE), messages = list( messages = FALSE, note = ""), ampl = list( ampl = FALSE, project = "ampl", solver = "ipopt", protocol = FALSE, trace = FALSE) ) } \arguments{ \item{model}{ a list, containing different arguments: type, estimator, params. See these arguments for further explanation. } \item{portfolio}{ a list, containing different arguments: weights, targetReturn, riskFreeRate, nFrontierPoints. See these arguments for further explanation. } \item{optim}{ a list with four entries, a character string \code{solver} denoting the type of the solver to be used, a \code{params} list to pass further arguments to the objective function to optimize, a \code{control} list for all control settings of the solver, and a logical flag, \code{trace} denoting if the optimization should be traced. } \item{messages}{ a list, for optional messages. } \item{ampl}{ a list, controls settings for the R/AMPL interface. } } \details{ To optimize a portfolio of assets we first have to specify it. All settings which specify a portfolio of assets are respresented by a S4 class named \code{fPFOLIOSPEC}. \preformatted{ setClass("fPFOLIOSPEC", representation( model = "list", portfolio = "list", optim = "list") ) } An object of class \code{fPFOLIOSPEC} has three slots, named \code{@model}, \code{@portfolio}, and \code{@optim}. The first slot \code{@model} holds the model information, the second slot \code{@portfolio} the portfolio information, and the last slot \code{@optim} the information about the solver used for optimization. The default settings are as follows: \preformatted{ model = list( type = "MV", optimize = "minRisk", estimator = "covEstimator", tailRisk = list(), params = list(alpha = 0.05, a = 2)), portfolio = list( weights = NULL, targetReturn = NULL, targetRisk = NULL, riskFreeRate = 0, nFrontierPoints = 50, status = NA), optim = list( solver = "solveRquadprog", objective = NULL, parames = list(), control = list(meq = 2), trace = FALSE) } \bold{Model Slot:} \emph{Type of Model:}\cr The list entry \code{type} from the \code{@model} slot describes the type of the desired portfolio. The current implementation supports three types of portfolios. This may be a Markowitz mean -- variance portfolio named \code{"MV"}, a mean -- lower partial moment portfolio named \code{"LPM"}, or a mean -- CVaR condititional value-at-risk portfolio named \code{"CVaR"}. One can use the function \code{getType} to retrieve the current setting and the function \code{setType} to modify this selection. \emph{What to optimize?}\cr The list entry \code{optimize} from the \code{@model} slot describes what should be optimized. Two choices are psssible. Either \preformatted{ \code{"minRisk"} } which minimizes the risk if the target returns is given, or \preformatted{ \code{"maxReturn"} } which maximizes the return if the target risk is given. One can use the function \code{getOptimize} to retrieve the current setting and the function \code{setOptimize} to modify this selection. \emph{How to estimate mean and covariance?}\cr The list entry \code{estimator} from the \code{@model} slot requests for a string that denotes the function name of the covariance estimator which should be used for the estimation of risk. In Markowitz' mean-variance portfolio model, \code{type="MV"}, the default function \preformatted{ \code{"covEstimator"} } is used which computes the standard column means of the multivariate assets data series and the standard covariance matrix. Alternative robust estimators include \preformatted{ \code{"covMcdEstimator"} \code{"covOGKEstimator"} \code{"mveEstimator"} \code{"nnveEstimator"} \code{"mcdEstimator"} } In addition a shrinkage covariance estimator named \preformatted{ \code{"shrinkEstimator"}, } and a bagged covariance estimator named \preformatted{ \code{"baggedEstimator"} } are also available. Note, the experienced user can add his own function to estimate in any alternative way the mean and the covariance of the multivariate assets data series. In this case (s)he has to write a function, e.g. named \preformatted{ \code{myEstimator=function(x,spec=NULL,...)} } where \code{x} is a multivariate time series, \code{spec} optionally the portfolio specification, if rquired, and \code{...} additional arguments passed to the users code. Note, \code{myEstimator} must a return a named list, with at least the following two entries \code{\$mu} and \code{\$Sigma}, which represent estimators for the mean and covariance, respectively. In the case of the Mean -- Lower-Partial-Moment portfolio, \code{type="LPM"} we make use of the equivalence to Markowitz' mean-variance portfolio with a modified covariance estimator, i.e. \preformatted{ \code{"lpmEstimator"}, } Note, in this case the setting of \code{type="LPM"} changes the covariance estimator function name from any selection previously made to the function automatically to \code{"lpmEstimator"} which returns the LPM mean and covariance estimates. One can use the function \code{getEstimator} to retrieve the current setting and the function \code{setEstimator} to modify this selection. \emph{Tail Risk List:}\cr The list entry \code{tailRisk} from the \code{@model} slot is an empty list. It can be used to add tail risk budget constrains to the optimization. In this case a square matrix of the size of the number of assets is expected as list entry, which contains bivariate tail risk measures, i.e. the tail dependence coefficients estaimated via a copulae approach. Use the function \code{setType} to modify this selection. The list entry \code{parameters} from the \code{@model} slot is a list with additional parameters used in different situations. It can be ebhanced by the user if needed. By default it contains the exponent \code{a=2}, the parameter needed for "LPM" portfolio optimization, and it contains the \code{targetAlpha=0.05}, the confidence level for "CVaR" portfolio optimization. Use the function \code{setParams} to modify this selection. \bold{Portfolio Slot:} The values \code{weights}, \code{targetReturn}, and \code{targetRisk} from the \code{portfolio} slot have to be considered in common. By default all three are set to \code{NULL}. If this is the case, then it is assumed that an equal weight portfolio should be calculated. If only one of the three values is different from \code{NULL} then the following procedure will be startet. If the weights are specified then it is assumed that a feasible portfolio should be considered. If the target return is fixed then it is assumed that the efficient portfolio with the minimal risk will be considered. And finally if the risk is fixed, then the return should be maximized. Use the functions \code{setWeights}, \code{setTargetReturn}, and \code{setTargetRisk} to modify this selection.Note, the change in of the three functions will influence the settings of the other two. The \code{riskFreeRate=0} is also stored in the \code{portfolio} slot. Its value defaults to zero. It can be changed by the user. Use the function \code{setRiskFreeRate} to modify this selection. The number of frontier points reqauired by the calculation of the \code{portfolioFrontier} is obtained from the value of \code{nFrontierPoints=50} hold in the \code{portfolio} slot. Its value defaults to 50. It can be changed by the user. Use the function \code{setNFrontierPoints} to modify this selection. The final \code{status} of portfolio optimization is returned and stored in the \code{portfolio} slot. Before optimization the value is unset to \code{NA}, after optimization a value of \code{status=0} means a successful termination. For other values we recommend to inspect the help page of the selected solver, the name of the solver can be returned by the function \code{getSolver}. Use the function \code{setSolver} to reset the value to \code{NA} if it should be required. \bold{Optim Slot:} The name of the default solver used for optimization can be retrieved calling the function \code{getSolver}. The default value for the value \code{solver} in the specification is set to \code{NULL} which means that the best solver availalbe will be autoselected and used. Before optimization the user can change the setting to another solver. Be aware, that a possible personal change will be overwritten by the function \code{setType}, so call \code{setSolver} after setting the type of the portfolio. The logical flag \code{trace} in the slot \code{optim} allows to trace optionally the portfolio optimization process. By default this will not be the case since the default value is \code{trace=FALSE}. Use the fanction \code{setTrace} to modify the selection. \bold{Retrieving and Modifying Specification Settings:} Information about the current portfolio specification can be retrieved by \code{"get"} functions. These include: \tabular{ll}{ \code{getType} \tab Extracts portfolio type from specification, \cr \code{getOptimize} \tab Extracts what to optimize from specification, \cr \code{getEstimator} \tab Extracts type of covariance estimator, \cr \code{getTailRisk} \tab Extracts list of tail dependency risk matrixes, \cr \code{getParams} \tab Extracts parameters from specification, \cr \code{getWeights} \tab Extracts weights from a portfolio object, \cr \code{getTargetReturn} \tab Extracts target return from specification, \cr \code{getTargetRisk} \tab Extracts target riks from specification, \cr \code{getAlpha} \tab Extracts target VaR-alpha specification, \cr \code{getRiskFreeRate} \tab Extracts risk free rate from specification, \cr \code{getNFrontierPoints} \tab Extracts number of frontier points, \cr \code{getStatus} \tab Extracts the status of optimization, \cr \code{getSolver} \tab Extracts solver from specification, \cr \code{getTrace} \tab Extracts solver's trace flag. } For details we refer to \code{link{getSpec}}. To modify the setting from a portfolio specification use the \code{"set"} functions: \tabular{ll}{ \code{setType} \tab Sets type of portfolio optimization, \cr \code{setOptimize} \tab Sets what to optimize, min risk or max return, \cr \code{setEstimator} \tab Sets names of mean and covariance estimators, \cr \code{setParams} \tab Sets optional model parameters, \cr \code{setWeights} \tab Sets weights vector, \cr \code{setTargetReturn} \tab Sets target return value, \cr \code{setTargetRisk} \tab Sets target risk value, \cr \code{setTargetAlpha} \tab Sets CVaR target alpha value, \cr \code{setRiskFreeRate} \tab Sets risk-free rate value, \cr \code{setNFrontierPoints} \tab Sets number of frontier points, \cr \code{setStatus} \tab Sets status value, \cr \code{setSolver} \tab Sets the type of solver to be used, \cr \code{setTrace} \tab Sets the logical trace flag. } For details we refer to \code{link{setSpec}}. \bold{Printing Specification Settings:} There is a generic print function to print information from specification. What is printed depends on the values of the settings. For example \code{print(portfolioSpec())} returns the type of portfolio, the name of the covariance estimator, the portfolios risk free rate, and the desired solver. } \value{ \code{portfolioSpec}\cr \cr returns an S4 object of class \code{"fPFOLIOSPEC"}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-riskPfolio.Rd0000644000175100001440000001415312620132672017616 0ustar hornikusers\name{portfolio-riskPfolio} \alias{riskPfolio} \alias{pfolioVaR} \alias{pfolioCVaR} \alias{pfolioCVaRplus} \alias{lambdaCVaR} \alias{pfolioCVaRoptim} \alias{pfolioMaxLoss} \alias{pfolioReturn} \alias{pfolioTargetReturn} \alias{pfolioTargetRisk} \alias{pfolioSigma} \alias{pfolioHist} \title{Risk and Related Measures for Portfolios} \description{ Computes Value-at-Risk and related measures for a portfolio of assets. The functions are: \tabular{ll}{ \code{pfolioVaR} \tab computes Value-at-Risk for a portfolio of assets, \cr \code{pfolioCVaRplus} \tab computes Value-at-Risk+ for a portfolio of assets, \cr \code{pfolioCVaR} \tab computes Conditional Value-at-Risk for a PF of assets, \cr \code{lambdaCVaR} \tab computes CVaR's atomic split value lambda, \cr \code{pfolioCVaRoptim} \tab computes Conditional VaR from mean-CVaR optimization, \cr \code{pfolioMaxLoss} \tab computes Maximum Loss for a portfolio of assets, \cr \code{pfolioReturn} \tab computes return values of a portfolio, \cr \code{pfolioTargetReturn} \tab computes the target return of a portfolio, \cr \code{pfolioTargetRisk} \tab computes the target risk of a portfolio, \cr \code{pfolioHist} \tab plots a histogram of the returns of a portfolio. } } \usage{ pfolioVaR(x, weights = NULL, alpha = 0.05) pfolioCVaRplus(x, weights = NULL, alpha = 0.05) pfolioCVaR(x, weights = NULL, alpha = 0.05) lambdaCVaR(n, alpha = 0.05) pfolioCVaRoptim(x, weights = NULL, alpha = 0.05) pfolioMaxLoss(x, weights = NULL) pfolioReturn(x, weights = NULL, geometric = FALSE) pfolioTargetReturn(x, weights = NULL) pfolioTargetRisk(x, weights = NULL) pfolioHist(x, weights = NULL, alpha = 0.05, range = NULL, details = TRUE, \dots) } \arguments{ \item{x}{ a 'timeSeries' object, data frame or any other rectangular object which can be expressed as a matrix. The first dimension is the number of observations, we call it \code{n}, and the second is the number of assets in the data set, we call it \code{dim}. } \item{weights}{ usually a numeric vector which has the length of the number of assets. The weights measures the normalized weights of the individual assets. By default \code{NULL}, then an equally weighted set of assets is assumed. } \item{geometric}{ a logical flag, should geometric returns be used, by default FALSE } \item{alpha}{ a numeric value, the confidence interval, by default 0.05. } \item{details}{ a logical value, should details be printed? } \item{n}{ the number of observation from which the CVaR's atomic split value \code{lambda=1-floor(alpha*n)/(alpha*n)} will be evaluated. } \item{range}{ a numeric vector of two elements limiting the plot range of the histogram. This is quite useful if one likes to compare several plots on the same scale. If \code{range=NULL}, the default value, then the range will be selected automatically. } \item{\dots}{ optional arguments to be passet to the function \code{hist}. } } \details{ The percentile measures of loss (or reward) are defined in the following way: Let \eqn{f(x ,y)} be a loss functions depending upon a decision vector \eqn{x = (x_1, ..., x_n )} and a random vector \eqn{y = (y_1, ..., y_m)}, then \emph{pfolioVaR} is the alpha-percentile of the loss distribution, a smallest value such that the probability that losses exceed or are equal to this value is greater or equal to alpha. \emph{pfolioCVaRplus} or "CVaR+" or the "upper CVaR" are the expected losses strictly exceeding VaR. This is also also called "Mean Excess Loss" and "Expected Shortfall". \emph{pfolioCVaR} is a weighted average of VaR and CVaRplus defined as \eqn{CVaR = lambda*VaR + (1-lambda)} CVaRplus, for \eqn{0 <= lambda <= 1}. Note, CVaR is convex, but VaR and CVaRplus may be non-convex. The following inequalities are valid: \eqn{VaR <= CVaR <= CVaRplus}. } \value{ \code{pfolioVaR} \cr returns the value of risk, VaR, for a portfolio of assets, a numeric value. \cr \code{pfolioCVaRplus} \cr returns the conditional value of risk plus, CVaRplus, for a portfolio of assets, a numeric value. \cr \code{pfolioCVaR} \cr returns the conditional value of risk, CVaR, for a portfolio of assets, a numeric value. \cr \code{lambdaCVaR} \cr returns CVaR's atomic split value \code{lambda}, a numeric value. \cr \code{pfolioMaxLoss} \cr returns the maximum loss value of the portfolio, a numeric value. \cr \code{pfolioReturn} \cr returns the total portfolio return computed from the set of assets \code{x}, a numeric vector. \cr \code{pfolioTargetReturn} \cr returns the total return or target return computed from the set of assets \code{x} and weights \code{weights}, a numeric value. \cr \code{pfolioTargetRisk} \cr returns the total risk (Sigma) or target risk computed from the set of assets \code{x} and \code{weights} via the formual \code{sqrt(weights \%*\% cov(x) \%*\% weights)}, a numeric value. \cr \code{pfolioHist} \cr plots a histogram of portfolio returns and adds the values for the VaR (blue), for the CVaRplus (red), and for the maximum loss (green) to the histogram plot. The function invisibly returns a list with the following elements: VaR, VaRplus, maxLoss, mean, and sd. If \code{details} is \code{TRUE}, then the result is printed. } \references{ Uryasev S. (2000); \emph{Conditional Value-at-Risk (CVaR): Algorithms and Applications}, Risk Management and Financial Engineering Lab, University of Florida Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{math} fPortfolio/man/monitor-stability.Rd0000644000175100001440000000431012323217772017152 0ustar hornikusers\name{monitor-stability} \alias{stabilityAnalytics} \alias{turnsAnalytics} \alias{drawdownsAnalytics} \alias{garchAnalytics} \alias{riskmetricsAnalytics} \alias{bcpAnalytics} \alias{pcoutAnalytics} \alias{addRainbow} \alias{waveletSpectrum} \alias{parAnalytics} \title{Monitoring Stability} \description{ Functions for time series aggregation, converting a time series from a daily to a monthly or weekly base. } \usage{ stabilityAnalytics(index, method=c("turns", "drawdowns", "garch", "riskmetrics", "bcp", "pcout"), \dots) turnsAnalytics(index, spar=0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="\%m/\%y") drawdownsAnalytics(index, spar=0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="\%m/\%y") garchAnalytics(index, spar = 0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="\%m/\%y") riskmetricsAnalytics(index, spar=0.5, lambda=0.9, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="\%m/\%y") bcpAnalytics(index, spar=0.5, FUN=returns, method=c("prob", "mean", "var"), main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="\%m/\%y") pcoutAnalytics(index, spar=0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="\%m/\%y", strong=TRUE, k=2, cs=0.25, outbound=0.25) addRainbow(analytics, palette=rainbow, a=0.3, b=0.8, K=100) waveletSpectrum(index, spar=0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="\%m/\%y") parAnalytics() } \arguments{ \item{index}{an object of class 'timeSeries'} \item{method}{name of selected analytics} \item{analytics}{analytics object} \item{\dots}{optional arguments} \item{spar}{0.5} \item{main}{""} \item{trace}{TRUE} \item{doplot}{TRUE} \item{at}{pretty()} \item{format}{"\%m/\%y"} \item{lambda}{riskmetricsAnalytics} \item{bcp}{bcpAnalytics} \item{FUN,strong,k,cs,outbound}{pcoutAnalytics} \item{palette,a,b,K}{addRainbow} } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-Constraints.Rd0000644000175100001440000001322312323217772020006 0ustar hornikusers\name{portfolio-constraints} \alias{portfolioConstraints} \alias{minWConstraints} \alias{maxWConstraints} \alias{eqsumWConstraints} \alias{minsumWConstraints} \alias{maxsumWConstraints} \alias{minBConstraints} \alias{maxBConstraints} \alias{listFConstraints} \alias{minFConstraints} \alias{maxFConstraints} \alias{minBuyinConstraints} \alias{maxBuyinConstraints} \alias{nCardConstraints} \alias{minCardConstraints} \alias{maxCardConstraints} \title{Portfolio Constraints} \description{ Computes portfolio constraints given constraints strings. } \usage{ portfolioConstraints(data, spec=portfolioSpec(), constraints="LongOnly", \dots) minWConstraints(data, spec=portfolioSpec(), constraints="LongOnly") maxWConstraints(data, spec=portfolioSpec(), constraints="LongOnly") eqsumWConstraints(data, spec=portfolioSpec(), constraints="LongOnly") minsumWConstraints(data, spec=portfolioSpec(), constraints="LongOnly") maxsumWConstraints(data, spec=portfolioSpec(), constraints="LongOnly") minBConstraints(data, spec=portfolioSpec(), constraints="LongOnly") maxBConstraints(data, spec=portfolioSpec(), constraints="LongOnly") listFConstraints(data, spec=portfolioSpec(), constraints="LongOnly") minFConstraints(data, spec=portfolioSpec(), constraints="LongOnly") maxFConstraints(data, spec=portfolioSpec(), constraints="LongOnly") minBuyinConstraints(data, spec=portfolioSpec(), constraints="LongOnly") maxBuyinConstraints(data, spec=portfolioSpec(), constraints="LongOnly") nCardConstraints(data, spec=portfolioSpec(), constraints="LongOnly") minCardConstraints(data, spec=portfolioSpec(), constraints="LongOnly") maxCardConstraints(data, spec=portfolioSpec(), constraints="LongOnly") } \arguments{ \item{constraints}{ a character value or character vector, containing the constraint strings. Setting constraints is described in the details section } \item{data}{ a list, having a statistics named list, having named entries 'mu' and 'Sigma', containing the information of the statistics\cr } \item{spec}{ an S4 object of class \code{fPFOLIOSPEC} as returned by the function \code{portfolioSpec}. } \item{\dots}{ arguments passed to the function \code{.setRdonlp2Constraints}. For internal use only. } } \details{ \bold{How to define constraints?} \cr\cr Constraints are defined by a character string or a vector of character strings. \emph{Summary Constraints: NULL, "LongOnly", "Short"} There are three special cases, the settings \code{constraints=NULL}, \code{constraints="Short"}, and \code{constraints="LongOnly"}. Note, that these three constraint settings are not allowed to be combined with more general constraint definitions. \code{NULL}: This selection defines the default value and is equivalent to the \code{"LongOnly"} case, see below. \code{"Short"}: This selection defines the case of unlimited short selling. i.e. each weight may range between \code{-Inf} and \code{Inf}. Consequently, there are no group constraints. Risk budget constraints are not included in the portfolio optimization. \code{"LongOnly"}: This selection is the same as the default setting. Each weight may range between \code{0} ans \code{1}. No group constraints and risk budget constraints will be included in the portfolio optimization. \emph{Lower and Upper Bounds: minW and maxW} \emph{Group Constraints: eqsumW, minsumW and maxsumW} Lower and upper bounded portfolios may be specified by a vector of character strings which describe executable code, setting values to to vectors \code{minW}, \code{maxW}, \code{minsumW}, and \code{maxsumW}. The individual string elements of the vector have the following form: \describe{ \item{box constraints}{ \code{"minW[Asset(s)]=Value(s)"}, and/or \cr \code{"maxW[Asset(s)]=Value(s)"}. } \item{sector constraints}{ \code{"minsumW[Asset(s)]=Value(s)"}, and/or \cr \code{"maxsumW[Asset(s)]=Value(s)"}. } } \code{Asset(s)} is an index of one or more assets, and \code{value} a numeric value or vector assigning the desired value. Note, if the \code{values} range between zero and one, then we have a long only portfolio allowing for box and group constraints of the weights. If the values are set to negative values, and values larger than one, then (constrained) short selling will be allowed. \emph{Risk Budget Constrained Portfolios:} By default, risk budgets are not included in the portfolio optimization. Covariance risk budgets have to be added explicitely, and have the following form: \describe{ \item{box constraints}{ \code{"minB[Asset(s)]=Value(s)"}, and/or \cr \code{"minB[Asset(s)]=Value(s)"}. } } Again, \code{Asset(s)} is an index of one or more assets, and \code{value} a numeric value or vector with numbers ranging between zero and one, assigning the desired risk budgets. Note, risk budget constraints will enforce diversification at the expense of return generation. The resulting portfolios will thus lie below the unconstrained efficient frontier. \emph{Non-Linear Constraints: listF, minF, maxF} } \value{ an object of class S4. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-efficientPfolio.Rd0000644000175100001440000000556512323217772020616 0ustar hornikusers\name{portfolio-efficientPortfolio} \alias{efficientPortfolio} \alias{maxratioPortfolio} \alias{tangencyPortfolio} \alias{minriskPortfolio} \alias{minvariancePortfolio} \alias{maxreturnPortfolio} \title{Efficient Portfolios} \description{ Returns efficient portfolios. } \usage{ efficientPortfolio(data, spec = portfolioSpec(), constraints = "LongOnly") maxratioPortfolio(data, spec = portfolioSpec(), constraints = "LongOnly") tangencyPortfolio(data, spec = portfolioSpec(), constraints = "LongOnly") minriskPortfolio(data, spec = portfolioSpec(), constraints = "LongOnly") minvariancePortfolio(data, spec = portfolioSpec(), constraints = "LongOnly") maxreturnPortfolio(data, spec = portfolioSpec(), constraints = "LongOnly") } \arguments{ \item{constraints}{ a character string vector, containing the constraints of the form\cr \code{"minW[asset]=percentage"} for box constraints resp. \cr \code{"maxsumW[assets]=percentage"} for sector constraints. } \item{data}{ a multivariate time series described by an S4 object of class \code{timeSeries}. If your timeSerie is not a \code{timeSeries} object, consult the generic function \code{as.timeSeries} to convert your time series. } \item{spec}{ an S4 object of class \code{fPFOLIOSPEC} as returned by the function \code{portfolioSpec}. } } \details{ \bold{Efficient Portfolio:} An efficient portfolio is a portfolio which lies on the efficient frontier. The \code{efficientPortfolio} function returns the properties of the efficient portfolio as an S4 object of class \code{fPORTFOLIO}. \bold{Minumum Risk or Tangency Portfolio:} The function \code{tangencyPortfolio} returns the portfolio with the highest return/risk ratio on the efficient frontier. For the Markowitz portfolio this is the same as the Sharpe ratio. To find this point on the frontier the return/risk ratio calculated from the target return and target risk returned by the function \code{efficientPortfolio}. \bold{Global minimum risk or Minimum Variance Portfolio:} The function \code{minvariancePortfolio} returns the portfolio with the minimal risk on the efficient frontier. To find the minimal risk point the target risk returned by the function \code{efficientPortfolio} is minimized. \bold{Maximum Return Portfolio:} The function \code{maxreturnPortfolio} returns the portfolio with the maximal return for a fixed target risk. } \value{ returns an S4 object of class \code{"fPORTFOLIO"}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-getData.Rd0000644000175100001440000000401412424415362017043 0ustar hornikusers\name{portfolio-getData} %%\alias{getData} %% \alias{getData.fPFOLIODATA} \alias{getSeries.fPFOLIODATA} \alias{getNAssets.fPFOLIODATA} \alias{getUnits.fPFOLIODATA} \alias{getStatistics.fPFOLIODATA} \alias{getMean.fPFOLIODATA} \alias{getCov.fPFOLIODATA} \alias{getMu.fPFOLIODATA} \alias{getSigma.fPFOLIODATA} \alias{getEstimator.fPFOLIODATA} \alias{getTailRisk.fPFOLIODATA} \title{Portfolio Data Extractor Functions} \description{ Extracts information from an object of class fPFOLIODATA. } \usage{ \method{getData}{fPFOLIODATA}(object) \method{getSeries}{fPFOLIODATA}(object) \method{getNAssets}{fPFOLIODATA}(object) \method{getUnits}{fPFOLIODATA}(x) \method{getStatistics}{fPFOLIODATA}(object) \method{getMean}{fPFOLIODATA}(object) \method{getCov}{fPFOLIODATA}(object) \method{getMu}{fPFOLIODATA}(object) \method{getSigma}{fPFOLIODATA}(object) \method{getEstimator}{fPFOLIODATA}(object) \method{getTailRisk}{fPFOLIODATA}(object) } \arguments{ \item{object}{ an object of class \code{fPFOLIODATA}. } \item{x}{ an object of class \code{fPFOLIODATA}. } } \details{ \tabular{ll}{ \code{getData} \tab Extracts data slot, \cr \code{getSeries} \tab Extracts assets series, \cr \code{getNAssets} \tab Extracts number of assets, \cr \code{getUnits} \tab Extracts names of assets, \cr \code{getStatistics} \tab Extracts statistics slot, \cr \code{getMean} \tab Extracs mean vector, \cr \code{getCov} \tab Extracs covariance matrix, \cr \code{getMu} \tab Extracs mu vector, \cr \code{getSigma} \tab Extracs Sigma matrix, \cr \code{getEstimator} \tab Extracs Sigma matrix, \cr \code{getTailRisk} \tab Extracts tail risk slot. } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/a-class-fPFOLIOCON.Rd0000644000175100001440000000122512323217772016502 0ustar hornikusers\name{fPFOLIOCON} \alias{fPFOLIOCON} \alias{class-fPFOLIOCON} \alias{fPFOLIOCON-class} \alias{show,fPFOLIOCON-method} \title{Portfolio Constraints Handling} \description{ Creates a fPFOLIOCON object from string constraints. } \usage{ \S4method{show}{fPFOLIOCON}(object) } \arguments{ \item{object}{ an object of class \code{fPFOLIOCON} as returned by the function \code{portfolioData}. } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/risk-surfaceRisk.Rd0000644000175100001440000000241012323217772016707 0ustar hornikusers\name{risk-surfaceRisk} \alias{markowitzHull} \alias{feasibleGrid} \alias{bestDiversification} \alias{riskSurface} \alias{surfacePlot} \title{Surface Risk Analytics} \description{ Functions for surface risk analytics. } \usage{ markowitzHull(data, nFrontierPoints=50) feasibleGrid(hull, trace=FALSE) bestDiversification(grid, FUN="var", trace=FALSE) riskSurface(diversification, FUN=NULL, \dots) surfacePlot(surface, type=c("image", "filled.contour"), nlevels=11, palette=topo.colors, addContour=TRUE, addGrid=TRUE, addHull=TRUE, addAssets=TRUE, \dots) } \arguments{ \item{data}{data} \item{hull}{hull} \item{surface}{surface} \item{diversification}{diversification} \item{FUN}{FUN} \item{grid}{grid} \item{nFrontierPoints}{nFrontierPoints} \item{trace}{trace} \item{type}{type} \item{nlevels}{nlevels} \item{palette}{palette} \item{addContour}{addContour} \item{addGrid}{addGrid} \item{addHull}{addHull} \item{addAssets}{addAssets} \item{\dots}{optional arguments} } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-Data.Rd0000644000175100001440000000051312323217772016346 0ustar hornikusers\name{portfolio-dataSets} \alias{portfolioData2} \title{portfolioData2} \description{ portfolioData2. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/a-class-fPFOLIOSPEC.Rd0000644000175100001440000000723412323217772016623 0ustar hornikusers\name{fPFOLIOSPEC} \alias{fPFOLIOSPEC} \alias{class-fPFOLIOSPEC} \alias{fPFOLIOSPEC-class} \alias{show,fPFOLIOSPEC-method} \title{Specification of Portfolios} \description{ Specifies portfolios. } \usage{ \S4method{show}{fPFOLIOSPEC}(object) } \arguments{ \item{object}{ an S4 object of class \code{fPFOLIOSPEC}. } } \details{ \bold{Portfolio Specifcation Structure:} \cr\cr The S4 class \code{fPFOLIOSPEC} specifies the portfolio. The slots are:\cr \describe{ \item{@call}{ a call, returning the matched function call. } \item{@model}{ a list, setting the \code{type} of portfolio to be optimized, and the mean/covariance \code{estimator} to be applied: \cr \code{type=c("MV","CVaR")} a character string denoting the type of portfolio, the implemented types are the Mean-Variance Markowitz Portfolio, \code{"MV"}, and the Mean-CVaR Portfolio, \code{"CVaR"}. \cr \code{estimator=c("mean","cov")} a vector of two character strings, the first denoting the mean estimator, and the second the covariance estimator. Additional meaningful selections include robust covariance estimators, e.g. \code{c("mean","mcd")}, or \code{c("mean","shrink")}. \cr \code{tailRisk=list()} a list of optional tail risk information, currently not used.\cr \code{params=list()} a list of optional model parameters, currently not used. } \item{@portfolio}{ a list, settings portfolio parameters including predefined weights, target return, risk free rate, number of frontier points: \cr \code{weights=NULL} a numeric vector specifying the portfolio weights. \cr \code{targetReturn=NULL} a numeric value specifying the target return. The default value sets the target return. \cr \code{targetRisk=NULL} a numeric value specifying the target risk.\cr \code{targetAlpha=NULL} a numeric value specifying the target alpha confidence level for CVaR portfolio optimization. The default value sets the target return. \cr \code{riskFreeRate=0} a numeric value specifying the risk free rate. \cr \code{nFrontierPoints=50} a numeric value determining the number of points on the efficient frontier. } \item{@solver}{ a list, setting the type of solver to be used for portfolio optimization: \cr \code{type=c("quadprog", "Rdonlp2", "lpSolve")} a character string specifying the name of the solver to be used.\cr \code{trace=FALSE} a logical flag, should the optimization be traced? } \item{@title}{ a title string, with a default project title. } \item{@description}{ a character string, with a default project description. } } } \value{ \code{portfolioSpec}\cr \cr returns an S4 object of class \code{"fPFOLIOSPEC"}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/solve-environment.Rd0000644000175100001440000000133512323217772017157 0ustar hornikusers\name{solve-environment} \alias{Data} \alias{portfolioObjective} \alias{portfolioReturn} \alias{portfolioRisk} \title{Nonlinear Objective Presettings} \description{ Prests variables for Data, portfolioObjective, portfolioReturn, and portfolioRisk in the case of NL math programming of portfolios. } \usage{ Data portfolioObjective(weights) portfolioReturn(weights) portfolioRisk(weights) } \arguments{ \item{weights}{ a vector of portfolio weights } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{optim} fPortfolio/man/weights-linePlots.Rd0000644000175100001440000000655312323217772017115 0ustar hornikusers\name{weights-linePlot} \alias{weightsLinePlot} \alias{weightedReturnsLinePlot} \alias{covRiskBudgetsLinePlot} %\alias{tailRiskBudgetsLinePlot} \title{Portfolio Weights Line Plots} \description{ Displays line plots of weights, weighted returns, covariance and tail risk budgets. } \usage{ weightsLinePlot(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) weightedReturnsLinePlot(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) covRiskBudgetsLinePlot(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) % NYI %tailRiskBudgetsLinePlot(object, labels = TRUE, col = NULL, title = TRUE, % box = TRUE, legend = TRUE, ...) } \arguments{ \item{object}{ an S4 object of class \code{fPORTFOLIO}, as returned by one of the portfolio functions, e.g. \code{efficientPortfolio} or \code{portfolioFrontier}. } \item{labels}{ a logical flag, determining if the the graph should be labeled automatically, which is the default case \code{labels=TRUE}. If set to \code{FALSE} then the graph will be displayed undecorated and the user can it decorate by himself. } \item{col}{ a character string vector, defined from a color palette. The default setting uses the "Blues" \code{seqPalette} palette. } \item{title}{ a logical flag. Should automatically a title and axis labels be added to the plot. } \item{box}{ a logical flag, determining whether a boxed frame should be plotted around the pie, by default the value is set to \code{TRUE}. } \item{legend}{ a logical value, determining if the the graph should be labeled automatically, shich is the default case \code{labels=TRUE}. If set to \code{FALSE} then the graph will be displayed undecorated and the user can it decorate by himself. Evenmore, if \code{labels} takes the value of a string vector, then the names of the assets from the porftolio \code{object} will be ignored, and the labels will be taken from the specified string vector. } \item{\dots}{ additional arguments passed to the function \code{barplot}. Only active if \code{labels=FALSE}. } } \details{ These line plots allow for different views on the results obtained from a feasible or an optimized portfolio. The function \code{weightsPlot} displays the weights composition along the frontier of a portfolio. The function \code{weightedReturnsPlot} displays the investment composition, i.e. the weighted returns along the frontier of a portfolio. The function \code{covRiskBudgetsPlot} displays the covariance risk budgets composition along the frontier of a portfolio. % NYI %The function \code{tailRiskBudgetsPlot} displays the copulae tail %risk budgets composition along the frontier of a portfolio. Note, %this is only possible if in the portfolio specification a copulae %tail risk is defined. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/data-sets.Rd0000644000175100001440000000157312323217772015356 0ustar hornikusers\name{data-sets} \alias{dataSets} \alias{GCCINDEX.DF} \alias{SPISECTOR.DF} \alias{SWX.DF} \alias{LPP2005.RET.DF} \alias{SMALLCAP.RET.DF} \alias{GCCINDEX} \alias{SPISECTOR} \alias{SWX} \alias{LPP2005} \alias{SMALLCAP} \alias{GCCINDEX.RET} \alias{SPISECTOR.RET} \alias{SWX.RET} \alias{LPP2005.RET} \alias{SMALLCAP.RET} \alias{ECON85} \alias{ECON85LONG} \title{Assets Data Sets} \description{ Example data sets for portfolio optimization. } \usage{ ECON85 ECON85LONG GCCINDEX SPISECTOR SWX LPP2005 SMALLCAP GCCINDEX.RET SPISECTOR.RET SWX.RET LPP2005.RET SMALLCAP.RET } %\details{ %} \value{ an object of class \code{"timeSeries"}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{datasets} fPortfolio/man/risk-budgeting.Rd0000644000175100001440000000225412330665056016404 0ustar hornikusers\name{risk-budgeting} %\alias{pfolioReturn} \alias{sampleCOV} \alias{normalVaR} \alias{modifiedVaR} \alias{sampleVaR} \alias{budgetsSampleCOV} \alias{budgetsNormalVAR} \alias{budgetsModifiedVAR} \alias{budgetsNormalES} \alias{budgetsModifiedES} \title{Risk Budgeting} \description{ Functions for risk budgeting. } \usage{ %pfolioReturn(x, weights, geometric=TRUE) sampleCOV(x) normalVaR(x, alpha=0.05) modifiedVaR(x, alpha=0.05) sampleVaR(x, alpha=0.05) budgetsSampleCOV(x, weights, mu=NULL, Sigma=NULL) budgetsNormalVAR(x, weights, alpha=0.05, mu=NULL, Sigma=NULL) budgetsModifiedVAR(x, weights, alpha=0.05, mu=NULL, Sigma=NULL, M3=NULL, M4=NULL) budgetsNormalES(x, weights, alpha=0.05, mu=NULL, Sigma=NULL) budgetsModifiedES(x, weights, alpha=0.05, mu=NULL, Sigma=NULL, M3=NULL, M4=NULL) } \arguments{ \item{x}{x} \item{weights}{weights} \item{alpha}{alpha} \item{mu,Sigma}{mean and covariance} \item{M3, M4}{M3 and M4} } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/portfolio-getSpec.Rd0000644000175100001440000000645112323217772017076 0ustar hornikusers\name{portfolio-getSpec} %%\alias{getSpec} %%conflicts with getDefault \alias{getModel.fPFOLIOSPEC} \alias{getType.fPFOLIOSPEC} \alias{getOptimize.fPFOLIOSPEC} \alias{getEstimator.fPFOLIOSPEC} \alias{getTailRisk.fPFOLIOSPEC} \alias{getParams.fPFOLIOSPEC} \alias{getAlpha.fPFOLIOSPEC} \alias{getA.fPFOLIOSPEC} \alias{getA} \alias{getMessages} \alias{getPortfolio.fPFOLIOSPEC} \alias{getWeights.fPFOLIOSPEC} \alias{getTargetReturn.fPFOLIOSPEC} \alias{getTargetRisk.fPFOLIOSPEC} \alias{getRiskFreeRate.fPFOLIOSPEC} \alias{getNFrontierPoints.fPFOLIOSPEC} \alias{getStatus.fPFOLIOSPEC} \alias{getOptim.fPFOLIOSPEC} \alias{getSolver.fPFOLIOSPEC} \alias{getObjective.fPFOLIOSPEC} \alias{getOptions.fPFOLIOSPEC} \alias{getControl.fPFOLIOSPEC} \alias{getTrace.fPFOLIOSPEC} \alias{getMessages.fPFOLIOSPEC} \title{Portfolio Specification Extractor Functions} \description{ Extracts information from an object of class fPFOLIOSPEC. } \usage{ \method{getModel}{fPFOLIOSPEC}(object) \method{getType}{fPFOLIOSPEC}(object) \method{getOptimize}{fPFOLIOSPEC}(object) \method{getEstimator}{fPFOLIOSPEC}(object) \method{getTailRisk}{fPFOLIOSPEC}(object) \method{getParams}{fPFOLIOSPEC}(object) \method{getPortfolio}{fPFOLIOSPEC}(object) \method{getWeights}{fPFOLIOSPEC}(object) \method{getTargetReturn}{fPFOLIOSPEC}(object) \method{getTargetRisk}{fPFOLIOSPEC}(object) \method{getAlpha}{fPFOLIOSPEC}(object) \method{getRiskFreeRate}{fPFOLIOSPEC}(object) \method{getNFrontierPoints}{fPFOLIOSPEC}(object) \method{getStatus}{fPFOLIOSPEC}(object) \method{getOptim}{fPFOLIOSPEC}(object) \method{getSolver}{fPFOLIOSPEC}(object) \method{getObjective}{fPFOLIOSPEC}(object) \method{getOptions}{fPFOLIOSPEC}(object) \method{getControl}{fPFOLIOSPEC}(object) \method{getTrace}{fPFOLIOSPEC}(object) \method{getMessages}{fPFOLIOSPEC}(object) } \arguments{ \item{object}{ an object of class \code{fPFOLIOSPEC}. } } \details{ \tabular{ll}{ \code{getType} \tab Extracts portfolio type from specification, \cr \code{getOptimize} \tab Extracts what to optimize from specification, \cr \code{getEstimator} \tab Extracts type of covariance estimator, \cr \code{getTailRisk} \tab Extracts list of tail dependency risk matrixes, \cr \code{getParams} \tab Extracts parameters from specification, \cr \code{getWeights} \tab Extracts weights from a portfolio object, \cr \code{getTargetReturn} \tab Extracts target return from specification, \cr \code{getTargetRisk} \tab Extracts target riks from specification, \cr \code{getAlpha} \tab Extracts target VaR-alpha specification, \cr \code{getRiskFreeRate} \tab Extracts risk free rate from specification, \cr \code{getNFrontierPoints} \tab Extracts number of frontier points, \cr \code{getStatus} \tab Extracts the status of optimization, \cr \code{getSolver} \tab Extracts solver from specification, \cr \code{getobjective} \tab Extracts name of objective function, \cr \code{getTrace} \tab Extracts solver's trace flag. } } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/man/solver-rfamily.Rd0000644000175100001440000000346412323217772016445 0ustar hornikusers\name{solver-family} \alias{solveRglpk.CVAR} \alias{solveRglpk.MAD} \alias{solveRampl.CVAR} \alias{solveRshortExact} \alias{solveRquadprog} \alias{solveRquadprog.CLA} \alias{solveRipop} \alias{solveRampl.MV} \alias{solveRsocp} \alias{solveRdonlp2} \alias{solveRsolnp} \title{LP, QP, and NLP Programming Solvers} \description{ Rmetrics solver interface. } \usage{ solveRglpk.CVAR(data, spec, constraints) solveRglpk.MAD(data, spec, constraints) solveRampl.CVAR(data, spec, constraints) solveRshortExact(data, spec, constraints) solveRquadprog(data, spec, constraints) solveRquadprog.CLA(data, spec, constraints) solveRipop(data, spec, constraints) solveRampl.MV(data, spec, constraints) solveRsocp(data, spec, constraints) solveRdonlp2(data, spec, constraints) solveRsolnp(data, spec, constraints) } \arguments{ \item{data}{ a time series or a named list, containing either a series of returns or named entries 'mu' and 'Sigma' being mean and covariance matrix. } \item{spec}{ an S4 object of class \code{fPFOLIOSPEC} as returned by the function \code{portfolioSpec}. } \item{constraints}{ a character string vector, containing the constraints of the form\cr \code{"minW[asset]=percentage"} for box constraints resp. \cr \code{"maxsumW[assets]=percentage"} for sector constraints. } } \value{ a list with the following named ebtries: \code{solver}, \code{optim}, \code{weights}, \code{targetReturn}, \code{targetRisk}, \code{objective}, \code{status}, \code{message}. } \references{ Wuertz, D., Chalabi, Y., Chen W., Ellis A. (2009); \emph{Portfolio Optimization with R/Rmetrics}, Rmetrics eBook, Rmetrics Association and Finance Online, Zurich. } \keyword{models} fPortfolio/DESCRIPTION0000644000175100001440000000160513630700055014122 0ustar hornikusersPackage: fPortfolio Title: Rmetrics - Portfolio Selection and Optimization Date: 2017-11-12 Version: 3042.83.1 Author: Diethelm Wuertz [aut], Tobias Setz [cre], Yohan Chalabi [ctb], William Chen [ctb] Maintainer: Tobias Setz Description: Provides a collection of functions to optimize portfolios and to analyze them from different points of view. Depends: R (>= 2.15.1), timeDate, timeSeries, fBasics, fAssets Imports: fCopulae, robustbase, MASS, Rglpk, slam, Rsolnp, quadprog, kernlab, rneos, methods, grDevices, graphics, stats, utils Suggests: Rsocp, Rnlminb2, Rdonlp2, Rsymphony, dplR, bcp, fGarch, mvoutlier Additional_repositories: http://r-forge.r-project.org/ LazyData: yes License: GPL (>= 2) URL: https://www.rmetrics.org NeedsCompilation: no Packaged: 2020-03-07 11:00:10 UTC; hornik Repository: CRAN Date/Publication: 2020-03-07 11:06:21 UTC fPortfolio/R/0000755000175100001440000000000013202316756012621 5ustar hornikusersfPortfolio/R/utils-exampleData.R0000644000175100001440000001462112410245174016326 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### .exampleData <- function() { dataSet <- data("LPP2005REC", package="timeSeries", envir=environment()) LPP2005REC <- get(dataSet, envir=environment()) nAssets = 6 lppData = 100 * (as.matrix(LPP2005REC[,-1]))[1:20, 1:nAssets] nScenarios = nrow(lppData) targetReturn = mean(lppData) Mean = colMeans(lppData) Cov = cov(lppData) start = rep(1/nAssets, nAssets) names(start) = colnames(lppData) madObjective = c( rep(1, nScenarios), rep(0, nAssets)) / nScenarios markowitzObjective = list(dvec = rep(0, nAssets), Dmat = Cov) sharpeObjective = function(x) { ( -Mean %*% x / sqrt ( x %*% Cov %*% x )[[1]] ) } markowitzFun = function(x) { ( x %*% Cov %*% x)[[1]] } sharpeFun = function(x) { ( -Mean %*% x / sqrt ( x %*% Cov %*% x )[[1]] ) } lower = 0 upper = 1 # For LP with glpk vec <- c( rep(1, nScenarios), rep(0, nAssets)) / nScenarios A <- rbind( c( rep(0, nScenarios), targetReturn = Mean), c( rep(0, nScenarios), budget = rep(1, nAssets)), cbind(-diag(nScenarios), Returns = lppData), cbind(+diag(nScenarios), Returns = lppData)) dirA <- c( rep("==", 2), rep("<=", nScenarios), rep(">=", nScenarios)) rhsA <- c( targetReturn = targetReturn, budget = 1, lower = rep(0, nScenarios), upper = rep(0, nScenarios)) # MAD with Box Constraints: madbox.linCons <- list( mat = rbind( c( rep(0, nScenarios), targetReturn = Mean), c( rep(0, nScenarios), budget = rep(1, nAssets)), cbind(-diag(nScenarios), Returns = lppData), cbind(+diag(nScenarios), Returns = lppData)), lower = c( targetReturn = targetReturn, budget = 1, rep(-Inf, nScenarios), rep( 0, nScenarios)), upper = c( targetReturn = targetReturn, budget = 1, rep( 0, nScenarios), rep(Inf, nScenarios))) # MAD with Box and Group Constraints: Bonds = c(1, 0, 0, 1, 0, 0); bonds = 0.3 # >= 30% Foreign = c(0, 0, 0, 1, 1, 1); foreign = 0.5 # <= 50% Equities = c(0, 0, 1, 0, 1, 1); equities = 0.6 # <= 60% madgroup.linCons = list( mat = rbind( c( rep(0, nScenarios), targetReturn = Mean), c( rep(0, nScenarios), budget = rep(1, nAssets)), c( rep(0, nScenarios), bons = Bonds), c( rep(0, nScenarios), foreign = Foreign), c( rep(0, nScenarios), equities = Equities), cbind(negDiag = -diag(nScenarios), Returns = lppData), cbind(posDiag = +diag(nScenarios), Returns = lppData)), lower = c( targetReturn = targetReturn, budget = 1, bonds = 0.3, foreign = 0, equities = 0, rep(-Inf, nScenarios), rep( 0, nScenarios)), upper = c( targetReturn = targetReturn, budget = 1, bonds = 1, foreign = 0.5, equities = 0.6, rep( 0, nScenarios), rep(Inf, nScenarios))) # QP Box Constrained Markowitz: Budget = rep(1, nAssets) investBudget = 1 qpbox.linCons <- list( mat = rbind(Return = Mean, Budget = Budget), lower = c(Return=targetReturn, Budget=investBudget), upper = c(Return=targetReturn, Budget=investBudget) ) # QP Box and Group Constrained Markowitz: Bonds = c(1, 0, 0, 1, 0, 0); bonds = 0.3 # >= 30% Foreign = c(0, 0, 0, 1, 1, 1); foreign = 0.5 # <= 50% Equities = c(0, 0, 1, 0, 1, 1); equities = 0.6 # <= 60% qpgroup.linCons <- list( mat = rbind(Return = Mean, Budget = Budget, Bonds = Bonds, Foreign = Foreign, Equtities = Equities), lower = c(Return=targetReturn, Budget=1, Bonds=0.3, Foreign=0.0, Equtities=0.0), upper = c(Return=targetReturn, Budget=1, Bonds=1.0, Foreign=0.5, Equtities=0.6) ) # QP Box Constrained Markowitz: qpbox.funCons <- list( fun = list( Return = function(x) { Mean %*% x }, Budget = function(x) { sum(x) } ), lower = c(Return=targetReturn, Budget=1), upper = c(Return=targetReturn, Budget=1) ) qpgroup.funCons <- list( fun = list( Return = function(x) { Mean %*% x }, Budget = function(x) { sum(x) }, Bonds = function(x) { Bonds %*% x }, Foreign = function(x) { Foreign %*% x }, Equtities = function(x) { Equities %*% x } ), lower = c(Return=targetReturn, Budget=1, Bonds=0.3, Foreign=0.0, Equtities=0.0), upper = c(Return=targetReturn, Budget=1, Bonds=1.0, Foreign=0.5, Equtities=0.6) ) budget.linCons <- list( mat = rbind(Budget = Budget), lower = investBudget, upper = investBudget) budget.funCons <- list( fun = list(function(x) sum(x)), lower = investBudget, upper = investBudget) groupbudget.funCons <- list( fun = list( Budget = function(x) { sum(x) }, Bonds = function(x) { Bonds %*% x }, Foreign = function(x) { Foreign %*% x }, Equtities = function(x) { Equities %*% x } ), lower = c(Budget=1, Bonds=0.3, Foreign=0.0, Equtities=0.0), upper = c(Budget=1, Bonds=1.0, Foreign=0.5, Equtities=0.6) ) } ############################################################################### fPortfolio/R/methods-plot.R0000644000175100001440000001557112323217770015373 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # plot.fPORTFOLIO S3 Plot method for 'fPORTFOLIO' objects # FUNCTION: DESCRIPTION: # .fPortfolio.plot1..8 Internal plot functions ################################################################################ plot.fPORTFOLIO <- function(x, which = "ask", control = list(), ...) { # A function implemented by Diethelm Wuertz # Description: # Plot method for an object of class 'fPORTFOLIO' # FUNCTION: # Control Parameters: Statistics = getStatistics(x) # Use default, if xlim and ylim is not specified ... mu = Statistics$mu Sigma = Statistics$Sigma N = length(mu) yLim = range(mu) + 0.25*c(-diff(range(mu)), diff(range(mu))) # First, take care that all assets appear on the plot ... # sqrtSig = sqrt(diag(Sigma)) # xLimAssets = c( # min(sqrtSig), # max(sqrtSig))+ c(-0.4*diff(range(sqrtSig)), 0.1*diff(range(sqrtSig))) xRange = range(frontierPoints(x)[, 1]) xDiff = diff(xRange) xLimAssets = c(xRange[1] - 2.5*xDiff/10, xRange[2] + xDiff/10) # ... second take care that the whole frontier appears on the plot: fullFrontier = frontierPoints(x) xLimFrontier = range(fullFrontier[, 1]) xLim = range(c(xLimAssets, xLimFrontier)) # Control List: # YC: merge with user control list con <- c(control, frontierPlotControl()) # YC: remove double entries and keep user args con <- con[unique(names(con))] attr(x, "control") <- con # Plot: interactivePlot( x, choices = c( "Plot Efficient Frontier", "Add Minimum Risk Portfolio", "Add Tangency Portfolio", "Add Risk/Return of Single Assets", "Add Equal Weights Portfolio", "Add Two Asset Frontiers [LongOnly Only]", "Add Monte Carlo Portfolios", "Add Sharpe Ratio [Markowitz PF Only]"), plotFUN = c( ".fportfolio.plot.1", ".fportfolio.plot.2", ".fportfolio.plot.3", ".fportfolio.plot.4", ".fportfolio.plot.5", ".fportfolio.plot.6", ".fportfolio.plot.7", ".fportfolio.plot.8"), which = which) # Return Value: invisible(x) } # ------------------------------------------------------------------------------ .fportfolio.plot.1 <- function(x) { # Description: # Plot Efficient Frontier # FUNCTION: # Control: con = attr(x, "control") Type = getType(x) if (Type == "MV") { xLab = "Mean-Var Target Risk" } else if (Type == "CVaR") { xLab = "-CVaR Target Risk" } # Plot: frontierPlot( object = x, xlim = con$xlim, ylim = con$ylim, pch = 19, cex = 0.75, title = FALSE, las = ifelse(is.null(con$las), 0, con$las)) title( main = ifelse(is.null(con$main), "Efficient Frontier", con$main), xlab = ifelse(is.null(con$xlab), xLab, con$xlab), ylab = ifelse(is.null(con$ylab), "Target Return", con$ylab)) } # ------------------------------------------------------------------------------ .fportfolio.plot.2 <- function(x) { # Description: # Add Minimum Risk Portfolio # FUNCTION: # Control: con = attr(x, "control") # Plot: minvariancePoints( object = x, col = con$minvariance.col, cex = con$minvariance.cex, pch = 19) } # ------------------------------------------------------------------------------ .fportfolio.plot.3 <- function(x) { # Description: # Add Tangency Portfolio # FUNCTION: # Control: con = attr(x, "control") # Plot: tangencyPoints( object = x, col = con$tangency.col, cex = con$tangency.cex, pch = 17) tangencyLines( object = x, col = con$tangency.col, cex = con$tangency.cex) } # ------------------------------------------------------------------------------ .fportfolio.plot.4 <- function(x) { # Description: # Add Risk/Return of Single Assets # FUNCTION: # Control: con = attr(x, "control") # Plot: Palette = match.fun(con$singleAsset.col) col = Palette(getNAssets(x)) singleAssetPoints( object = x, col = col, cex = con$singleAsset.cex, pch = 18) } # ------------------------------------------------------------------------------ .fportfolio.plot.5 <- function(x) { # Description: # Add Equal Weights Portfolio # FUNCTION: # Control: con = attr(x, "control") # Plot: equalWeightsPoints( object = x, col = con$equalWeights.col, cex = con$equalWeights.cex, pch = 15) } # ------------------------------------------------------------------------------ .fportfolio.plot.6 <- function(x) { # Description: # Add Two Asset Frontiers [0-1 PF Only] # FUNCTION: # Control: con = attr(x, "control") # Lines: lines(frontierPoints(object = x), col = "grey") twoAssetsLines(object = x, col = con$twoAssets.col) # Points: Palette = match.fun(con$singleAsset.col) col = Palette(getNAssets(x)) singleAssetPoints( object = x, col = col, cex = con$singleAsset.cex, pch = 18) } # ------------------------------------------------------------------------------ .fportfolio.plot.7 <- function(x) { # Description: # Add Monte Carlo Portfolios # FUNCTION: # Control: con = attr(x, "control") # Plot: monteCarloPoints( object = x, col = con$monteCarlo.col, cex = con$monteCarlo.cex, mcSteps = con$mcSteps) } # ------------------------------------------------------------------------------ .fportfolio.plot.8 <- function(x) { # Description: # Add Sharpe Ratio [MV PF Only] # FUNCTION: # Control: con = attr(x, "control") # Plot: sharpeRatioLines( object = x, col = con$sharpeRatio.col, cex = con$sharpeRatio.cex, lty = 3) } ################################################################################ fPortfolio/R/mathprogLP-symphony.R0000644000175100001440000001033112620372204016674 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # rsymphonyLP Rmetrics Interface for SYMPHONY LP solvers # symphonyLP Convenience wrapper for SYMPHONY LP solvers # symphonyLPControl SYMPHONY LP control parameter list ############################################################################### rsymphonyLP <- function(objective, lower=0, upper=1, linCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Function wrapper for symphony solver # Argments: # objective - numeric vector. # lwer, upper - box constraints # linCons - linear constraints: mat, lower and upper # control - control list # FUNCTION: # Update Control List: ctrl <- symphonyLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Box Constraints: N = length(objective) if(length(lower) == 1) { par.lower <- rep(lower, N) } else { par.lower <- lower } if(length(upper) == 1) { par.upper <- rep(upper, N) } else { par.upper <- upper } bounds <- list( lower = list(ind = 1:N, val = par.lower), upper = list(ind = 1:N, val = par.upper)) # Linear Constraints: mat <- linCons[[1]] M <- nrow(mat) lower <- as.vector(linCons[[2]]) upper <- as.vector(linCons[[3]]) if(length(lower) == 1) { lower <- rep(lower, M) } else { lower <- lower } if(length(upper) == 1) { upper <- rep(upper, M) } else { upper <- upper } eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) eqA <- mat[eqIndex, ] ineqA <- mat[ineqIndex, ] mat <- rbind(eqA, ineqA, ineqA) dir <- c(rep("==", length(eqIndex)), rep("<=", length(ineqIndex)), rep(">=", length(ineqIndex))) rhs <- c(upper[eqIndex], upper[ineqIndex], lower[ineqIndex]) mat <- mat[is.finite(rhs), ] dir <- dir[is.finite(rhs)] rhs <- rhs[is.finite(rhs)] # Optimize Portfolio: optim <- symphonyLP( obj = objective, mat = mat, dir = dir, rhs = rhs, bounds = bounds, types = NULL, max = FALSE) # Version: version <- paste(packageDescription("Rsymphony")[1:3], collapse=" ") # Return Value: value = list( opt = optim, solution = optim$solution, objective = optim$objval, status = optim$status[[1]], message = names(optim$status), solver = paste("R", control$solver), version = version) class(value) <- c("solver", "list") value } # ----------------------------------------------------------------------------- symphonyLP <- function(...) { Rsymphony::Rsymphony_solve_LP(...) } # ----------------------------------------------------------------------------- symphonyLPControl <- function(solver="symphony", project="r", trace=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns control parameter list # FUNCTION: # Return Value: list(solver=solver, trace=trace) } ############################################################################### fPortfolio/R/backtest-defaultFunctions.R0000644000175100001440000001122512323217770020057 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # equidistWindows Defines default equal distant rolling windows # tangencyStrategy Defines default tangency strategy portfolio # emaSmoother Defines default EMA weights smoother ################################################################################ equidistWindows <- function(data, backtest = portfolioBacktest()) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Defines default equidistant rolling windows # Arguments: # data - portfolio assets set, an object of class 'timeSeries' # backtest - an object of class 'fPFOLIOBACKTEST' # Note: # This is an example for a user defined windows function ... # Example: # equidistWindows(as.timeSeries(data(LPP2005REC))) # FUNCTION: # Settings: horizon = getWindowsHorizon(backtest) # Rolling Windows: ans = rollingWindows(x = data, period = horizon, by = "1m") # Return Value: ans } # ------------------------------------------------------------------------------ tangencyStrategy <- function(data, spec = portfolioSpec(), constraints = "LongOnly", backtest = portfolioBacktest()) { # A function implemented by Diethelm Wuertz and William Chen # FUNCTION: # Strategy Portfolio: strategyPortfolio <- try(tangencyPortfolio(data, spec, constraints)) # If tangency portfolio doesn't exist take the minimum variance portfolio: if (class(strategyPortfolio) == "try-error") { strategyPortfolio <- minvariancePortfolio(data, spec, constraints) } # Return Value: strategyPortfolio } # ------------------------------------------------------------------------------ emaSmoother <- function(weights, spec, backtest) { # A function implemented by Diethelm Wuertz and William Chen # Description: # A user defined weights smoother for portfolio backtesting # Arguments: # weights - a numeric matrix of weights # spec - portfolio spec, an object of class fPFLOLIOSPEC # backtest - portfolio backtest, an object of class fPFLOLIOBACKTEST # Example: # ans = portfolioBacktesting( ... ) # emaSmoother(ans$weights, spec, backtest) # FUNCTION: # EMA Function: ema <- function (x, lambda) { x = as.vector(x) lambda = 2/(lambda + 1) xlam = x * lambda xlam[1] = x[1] ema = filter(xlam, filter = (1 - lambda), method = "rec") ema[is.na(ema)] <- 0 as.numeric(ema) } # Lambda: lambda <- getSmootherLambda(backtest) lambdaLength <- as.numeric(substr(lambda, 1, nchar(lambda) - 1)) lambdaUnit <- substr(lambda, nchar(lambda), nchar(lambda)) stopifnot(lambdaUnit == "m") lambda <- lambdaLength # Initial Weights: nAssets <- ncol(weights) initialWeights = getSmootherInitialWeights(backtest) if (!is.null(initialWeights)) weights[1, ] = initialWeights # Compute Exponentially Smoothed Weights: smoothWeights1 = NULL for (i in 1:nAssets) { # print("first smooth") EMA <- ema(weights[, i], lambda = lambda) smoothWeights1 <- cbind(smoothWeights1, EMA) } # Double Smoothing ? doubleSmooth <- getSmootherDoubleSmoothing(backtest) if (doubleSmooth) { # print("second smooth") smoothWeights = NULL for (i in 1:nAssets) { EMA <- ema(smoothWeights1[, i], lambda = lambda) smoothWeights = cbind(smoothWeights, EMA) } } else { smoothWeights <- smoothWeights1 } # Add Names: rownames(smoothWeights) <- rownames(weights) colnames(smoothWeights) <- colnames(weights) # Return Value: smoothWeights } ################################################################################ fPortfolio/R/mathprogLP-glpk.R0000644000175100001440000001026012323217770015752 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # rglpkLP Rmetrics Interface for Rglpk LP solver # glpkLP Convenience wrapper for Rglpk LP solver # glpkLPControl Rglpk LP control parameter list ############################################################################### rglpkLP <- function(objective, lower=0, upper=1, linCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Convenience wrapper for solver Rglpk_solve_LP() # Argments: # objective - numeric vector. # lwer, upper - box constraints # linCons - linear constraints: mat, lower and upper # control - control list # FUNCTION: # Update Control List: ctrl <- glpkLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Box Constraints: N <- length(objective) if(length(lower) == 1) { par.lower = rep(lower, N) } else { par.lower = lower } if(length(upper) == 1) { par.upper = rep(upper, N) } else { par.upper = upper } bounds <- list( lower = list(ind = 1:N, val = par.lower), upper = list(ind = 1:N, val = par.upper)) # Linear Constraints: mat <- linCons[[1]] M <- nrow(mat) lower <- as.vector(linCons[[2]]) upper <- as.vector(linCons[[3]]) if(length(lower) == 1) { lower <- rep(lower, M) } else { lower <- lower } if(length(upper) == 1) { upper <- rep(upper, M) } else { upper <- upper } eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) eqA <- mat[eqIndex, ] ineqA <- mat[ineqIndex, ] mat <- rbind(eqA, ineqA, ineqA) dir <- c(rep("==", length(eqIndex)), rep("<=", length(ineqIndex)), rep(">=", length(ineqIndex))) rhs <- c(upper[eqIndex], upper[ineqIndex], lower[ineqIndex]) mat <- mat[is.finite(rhs), ] dir <- dir[is.finite(rhs)] rhs <- rhs[is.finite(rhs)] # Optimize Portfolio: optim <- glpkLP( obj = objective, mat = mat, dir = dir, rhs = rhs, types = NULL, max = FALSE, bounds = bounds, verbose = control$trace) # Version: version <- paste(packageDescription("Rglpk")[1:3], collapse=" ") # Return Value: value <- list( opt = optim, solution = optim$solution, objective = optim$optimum, status = optim$status, message = "none", solver = paste("R", control$solver), version = version) class(value) <- c("solver", "list") value } # ----------------------------------------------------------------------------- glpkLP <- Rglpk::Rglpk_solve_LP # ----------------------------------------------------------------------------- glpkLPControl <- function(solver = "glpk", project="r", trace=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns control parameter list # FUNCTION: # Return Value: list(solver=solver, trace=trace) } ############################################################################### fPortfolio/R/methods-summary.R0000644000175100001440000000357612323217770016114 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # summary.fPORTFOLIO S3 Summary method for 'fPORTFOLIO' objects ################################################################################ summary.fPORTFOLIO <- function(object, ...) { # A function implemented by Diethelm Wuertz # Description: # Plot method for an object of class 'fPORTFOLIO' # Note: # This method can also be used for plotting graphs fitted by # the function 'garch' from the contributed R package 'tseries'. # FUNCTION: # Summary: print(object) funCalled = as.character(object@call[1]) if (funCalled == "portfolioFrontier") { weightsPlot(object) weightedReturnsPlot(object) covRiskBudgetsPlot(object) # Plot Frontier: plot(object, which = 1) } else { weightsPie(object) weightedReturnsPie(object) covRiskBudgetsPie(object) } # Return Value: invisible(object) } ################################################################################ fPortfolio/R/backtest-pfolioBacktesting.R0000644000175100001440000002575512421162422020216 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # portfolioBacktesting Performs a portfolio backtesting # portfolioSmoothing Smoothes the weights of a portfolio backtesting ################################################################################ portfolioBacktesting <- function(formula, data, spec = portfolioSpec(), constraints = "LongOnly", backtest = portfolioBacktest(), trace = TRUE) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Backtests a portfolio on rolling windows # Arguments: # formula - a formula expression to select benchmark and assets # from the data set # data - data set of assets returns, an object of class fPFLOLIODATA # or timeSeries # spec - portfolio specification, an object of class fPFLOLIOSPEC, # by default as returned by the function portfolioSpec() # constraints - portfolio constraints, a vector of character strings # backtest - portfolio backtest specification, an object of # class fPFLOLIOBACKTEST, by default as returned by the function # portfolioBacktest # trace - a logical, should the backtesting be traced ? # Value: # A list with the following elements # formula - the input formula # data - the input data set # spec - the input portfolio specification # constraints - the input constraints # backtest - the input backtest specification # benchmarkName - the name of the benchmark returns # assetsNames - the names of the assets returns # weights - the rolling weights matrix # strategyList - the rolling list of optimized portfolios # Sigma - ... # Details: # Allows for user specified rolling Windows # Smoothing is separated and can be user specified # Example: # portfolioBacktesting(formula, data, spec, constraints, backtest) # FUNCTION: # Data: if (class(data) == "fPFOLIODATA") { Data <- data data <- getSeries(data) } else if (class(data) == "timeSeries") { Data <- portfolioData(data, spec) } # Constraints: if (class(constraints) == "fPFOLIOSPEC") { Constraints <- constraints constraints <- Constraints@stringConstraints } else if (class(constraints) == "character") { Constraints <- portfolioConstraints(data, spec, constraints) } # Formula, Benchmark and Asset Labels: benchmarkName = as.character(formula)[2] assetsNames <- strsplit(gsub(" ", "", as.character(formula)[3]), "\\+")[[1]] nAssets <- length(assetsNames) # Trace the Specifications and Data Info: if(trace) { cat("\nPortfolio Backtesting:\n") cat("\nAssets: ", assetsNames) cat("\nBenchmark: ", benchmarkName) cat("\nStart Series: ", as.character(start(data))) cat("\nEnd Series: ", as.character(end(data))) cat("\n Type: ", getType(spec)) cat("\n Cov Estimator: ", getEstimator(spec)) cat("\n Solver: ", getSolver(spec)) cat("\nPortfolio Windows: ", getWindowsFun(backtest)) cat("\n Horizon: ", getWindowsHorizon(backtest)) cat("\nPortfolio Strategy: ", getStrategyFun(backtest)) cat("\nPortfolio Smoother: ", getSmootherFun(backtest)) cat("\n doubleSmoothing: ", getSmootherDoubleSmoothing(backtest)) cat("\n Lambda: ", getSmootherLambda(backtest)) } # We invest in the "Strategy" or (return) efficient Portfolio: if(trace) { cat("\n\nPortfolio Optimization:") cat("\nOptimization Period\tTarget\tBenchmark\t Weights\n") } # Create Rolling Windows: windowsFun <- match.fun(getWindowsFun(backtest)) rollingWindows <- windowsFun(data, backtest) from <- rollingWindows$from to <- rollingWindows$to # Roll the Portfolio: strategyFun <- match.fun(getStrategyFun(backtest)) strategyList <- list() # WC: track the sigma over time: Sigma <- NULL for (i in 1:length(from)) { # Optimize the Portfolio: pfSeries <- window(data[, assetsNames], start = from[i], end = to[i]) bmSeries <- window(data[, benchmarkName], start = from[i], end = to[i]) pfSeries <- portfolioData(pfSeries, spec) Sigma <- c(Sigma, mean(diag(getSigma(pfSeries)))) strategy <- strategyFun( data = getSeries(pfSeries), spec = spec, constraints = constraints, backtest = backtest) strategyList[[i]] <- strategy # Trace Optionally the Results: if (trace) { cat(as.character(from[i]), as.character(to[i])) spReturn <- getTargetReturn(strategy@portfolio)[[2]] cat("\t", round(spReturn[1], digits = 3)) bmReturn <- mean(series(bmSeries)) cat("\t", round(bmReturn, digits = 3)) nAssets <- length(assetsNames) weights <- round(getWeights(strategy), digits = 3) cat("\t") for (i in 1:length(assetsNames)) cat("\t", weights[i]) cat("\t * ", round(sum(weights), 2)) cat("\n") } } # Extract Portfolio Investment Weights for the current period: weights <- NULL for (i in 1:length(strategyList)) weights <- rbind(weights, getWeights(strategyList[[i]])) rownames(weights) <- as.character(to) colnames(weights) <- assetsNames # Compose Result: ans <- list( formula = formula, data = data, spec = spec, constraints = constraints, backtest = backtest, benchmarkName = benchmarkName, assetsNames = assetsNames, weights = weights, strategyList = strategyList, Sigma = Sigma) # Return Value: class(ans) <- c("portfolioBacktesting", "list") invisible(ans) } # ------------------------------------------------------------------------------ portfolioSmoothing <- function(object, backtest=NULL, trace=TRUE) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Flexible Weights Smoother Function # Arguments: # object - an object as returned by the function portfolioBacktesting() # backtest - an S4 class object of 'FPFOLIOBACKTEST', the same as # used in the function portfolioBacktesting() or a user modified # version (obsolete) # trace - a logical, should the computation be traced ? # Value: # a list with the following entries # Example: # data <- 100*SWX.RET; object=portfolioBacktesting(LP40~SBI+SPI+SII, data) # portfolioSmoothing(object) # FUNCTION: # Obsolete Argument if (!is.null(backtest)) { warning("The backtest argument is obsolete and will be removed for the next release.") } # Backtest Settings: formula <- object$formula data <- object$data spec <- object$spec constraints <- object$constraints backtest <- object$backtest benchmarkName <- object$benchmarkName assetsNames <- object$assetsNames weights <- object$weights skip <- getSmootherSkip(backtest) if (skip > 0) weights <- weights[-(1:skip), ] nAssets <- ncol(weights) # Add Smooth Weights to Backtest object: if (trace) print("smooth ...") smoother <- match.fun(getSmootherFun(backtest)) smoothWeights <- object$smoothWeights <- smoother(weights, spec, backtest) # Compute Monthly Assets and Benchmark Returns: if (trace) print("aggregate ...") ow <- options("warn") options(warn = -1) monthlyAssets <- object$monthlyAssets <- applySeries(data[, assetsNames], by = "monthly", FUN = colSums) monthlyBenchmark <- object$monthlyBenchmark <- applySeries(data[, benchmarkName], by = "monthly", FUN = colSums) options(ow) # Compute Offset Return of Rolling Portfolio compared to Benchmark: if (trace) print("offset ...") cumX <- colCumsums(data[, benchmarkName]) lastX <- window(cumX, start = start(cumX), end = rownames(weights)[1] ) offsetReturn <- as.vector(lastX[end(lastX), ]) names(offsetReturn) <- as.character(end(lastX)) object$offsetReturn <- offsetReturn # Backtest Return Series: Datum <- as.vector(rownames(smoothWeights)) nDatum <- length(Datum) Portfolio = Benchmark = NULL for (i in 1:(nDatum-1)) { Portfolio <- rbind(Portfolio, as.vector(( as.matrix(monthlyAssets[Datum[i+1], ]) %*% smoothWeights[Datum[i], ]))) Benchmark <- rbind(Benchmark, as.vector(monthlyBenchmark[Datum[i+1], ])) } # Portfolio: P <- timeSeries(data = Portfolio, charvec = Datum[-1], units = "Portfolio") object$portfolioReturns <- portfolio <- colCumsums(P) object$P <- P # Benchmark: B <- timeSeries(data = Benchmark, charvec = Datum[-1], units = "Benchmark") object$benchmarkReturns <- benchmark <- colCumsums(B) object$B <- B daily <- colCumsums(data[, benchmarkName]) Daily <- window(daily, start = start(portfolio), end = end(portfolio)) portfolio <- portfolio - portfolio[1] + Daily[1] benchmark <- benchmark - benchmark[1] + Daily[1] # Add to backtest: object$portfolio <- portfolio object$benchmark <- benchmark # Backtest Statistics: P <- as.vector(P) B <- as.vector(B) Stats <- c(sum(P, na.rm = TRUE), sum(B)) Stats <- rbind(Stats, c(mean(P, na.rm = TRUE), mean(B))) Stats <- rbind(Stats, c(sd(P, na.rm = TRUE), sd(B))) Stats <- rbind(Stats, c(min(P, na.rm = TRUE), min(B))) colnames(Stats) <- c( "Portfolio", "Benchmark") rownames(Stats) <- c( "Total Return", "Mean Return", "StandardDev Return", "Maximum Loss") object$stats <- Stats # Return Value: class(object) <- c("portfolioSmoothing", "list") object } ################################################################################ fPortfolio/R/utils-methods.R0000644000175100001440000000324712323217770015552 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: # print.solver # summary.solver ############################################################################### print.solver <- function(x, ...) { # A function implemented by Diethelm Wuertz # Number of Variables: nSolution <- length(x$solution) # Print: cat("\nSolver: ", x$solver) cat("\nSolution: ", 1, ":", x$solution[1]) for (i in 2:nSolution) cat("\n ", i, ":", x$solution[i]) cat("\nObjective: ", x$objective) cat("\nStatus: ", x$status) cat("\nMessage: ", x$message) cat("\n") } # ----------------------------------------------------------------------------- .summary.solver <- function(object, ...) { # A function implemented by Diethelm Wuertz # Print: print(object[1]) } ############################################################################### fPortfolio/R/mathprogLP.R0000644000175100001440000001574712410257530015031 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # rsolveLP General function wrapper for LP solvers # .solveLP.MAD.demo MAD portfolio example # .solveLP.GLPK.demo GLPK help page example ############################################################################### rsolveLP <- function(objective, lower=0, upper=1, linCons, control=list(solver="glpk", invoke=c("R", "AMPL", "NEOS"))) { # A function implemented by Diethelm Wuertz # Description: # Rmetrics Interface for AMPL/NEOS LP solvers # Argments: # objective - numeric vector. # lwer, upper - box constraints # linCons - linear constraints: mat, lower and upper # control - control list # Control: solver <- control$solver invoke <- control$invoke[1] # Solve Linear Problem: if (invoke == "R") { rfooLP <- match.fun ( paste("r", solver, "LP", sep="")) ans <- rfooLP(objective, lower, upper, linCons, control) } if (invoke == "AMPL" ) { ans <- ramplLP(objective, lower, upper, linCons, control) } if (invoke == "NEOS" ) { ans <- rneosLP(objective, lower, upper, linCons, control) } ans$solver <- paste(invoke, ans$solver) # Return Value: ans } ############################################################################### .solveLP.MAD.demo <- function() { # Solve MAD Portfolio: # Load Dataset dataSet <- data("LPP2005REC", package="timeSeries", envir=environment()) LPP2005REC <- get(dataSet, envir=environment()) # Load Swiss Pension Fund Data: nAssets <- 6 nScenarios <- 100 data <- 100 * LPP2005REC[1:nScenarios, 1:nAssets] Mean <- colMeans(data) Data <- as.matrix(data) targetReturn <- mean(data) # Objective Function: vec <- c(weights=rep(0, nAssets), scenarios=rep(1/nScenarios, nScenarios)) # Set up Constraints Matrix: mat <- rbind( MAD.LE = cbind(Data, -diag(nScenarios)), MAD.GE = cbind(Data, +diag(nScenarios)), RETURN = t(c(Mean, rep(0, nScenarios))), BUDGET = t(c(rep(1, nAssets), rep(0, nScenarios))), X = cbind(matrix(rep(0, nAssets*nScenarios),ncol=nAssets), diag(nScenarios)), WEIGHTS = cbind(diag(nAssets), matrix(rep(0, nScenarios*nAssets), nrow=nAssets))) # Set up Right Hand Side of Constraints Equations: rhs <- c( MAD.LE = rep(0, nScenarios), MAD.GE = rep(0, nScenarios), RETURN = targetReturn, BUDGET = 1, X = rep(0, nScenarios), WEIGHTS = rep(0, nAssets)) # Set up Vector of Directions: dir <- c( MAD.LE = rep("<=", nScenarios), MAS.GE = rep(">=", nScenarios), RETURN = "==", BUDGET = "==", X = rep(">=", nScenarios), WEIGHTS = rep(">=", nAssets)) # Conversions: RHS <- rep(Inf, times=length(dir)) RHS[dir == "<="] <- rhs[dir == "<="] RHS[dir == "=="] <- rhs[dir == "=="] LHS <- rep(-Inf, times=length(dir)) LHS[dir == ">="] <- rhs[dir == ">="] LHS[dir == "=="] <- rhs[dir == "=="] # Arguments: objective <- vec lower <- 0 upper <- 1 linCons <- list(mat, LHS, RHS) control <- list() # Contributed R Solver - Original Function Calls: Rglpk::Rglpk_solve_LP(vec, mat, dir, rhs) # Contributed R Solver - Interfaced rglpkLP(objective, lower, upper, linCons) # AMPL: ramplLP(objective, lower, upper, linCons) # All AMPL: for (solver in c( "cplex", "donlp2", "gurobi", "loqo", "lpsolve", "minos", "snopt", "ipopt", "bonmin", "couenne")) { ans <- ramplLP(objective=vec, lower, upper, linCons, control=list(solver=solver)) print(ans) } # NEOS: # require(rneos) # lp: Linear Programming Solver: for (solver in c("gurobi", "mosek", "ooqp")) print(rneosLP(objective=vec, lower, upper, linCons, control=list(solver=solver, category="lp"))) # nco: Using Nonlinear Constrained Optimization Solver: for (solver in c( "conopt", "filter", "knitro", "lancelot", "loqo", "minos", "mosek", "pennon", "snopt")) print(rneosLP(objective=vec, lower, upper, linCons, control=list(solver=solver, category="nco"))) } # ----------------------------------------------------------------------------- .solveLP.GLPK.demo <- function() { # GLPK Demo from Help Rglpk Page: vec <- -c(2, 4, 3) mat <- matrix(c( 3, 2, 1, 4, 1, 3, 2, 2, 2), 3, 3) dir <- c("<=", "<=", "<=") rhs <- c(60, 40, 80) # For Testing: # mat <- rbind(mat, c(0,0,0)) # dir <- c(dir, "<=") # rhs <- c(rhs, 1000) # Arguments: objective <- vec lower <- 0 upper <- Inf linCons <- list(mat, lower=-Inf, upper=rhs) control <- list() # Contributed R Solver - Original Function Calls: Rglpk::Rglpk_solve_LP(vec, mat, dir, rhs) # Contributed R Solver - Interfaced rglpkLP(objective, lower, upper, linCons) # AMPL: ramplLP(objective, lower, upper, linCons) # All AMPL: for (solver in c( "cplex", "donlp2", "gurobi", "loqo", "lpsolve", "minos", "snopt", "ipopt", "bonmin", "couenne")) { ans <- ramplLP(objective=vec, lower, upper, linCons, control=list(solver=solver)) print(ans) } # NEOS: # require(rneos) # lp: Linear Programming Solver: for (solver in c("gurobi", "mosek", "ooqp")) print(rneosLP(objective=vec, lower, upper, linCons, control=list(solver=solver, category="lp"))) # nco: Using Nonlinear Constrained Optimization Solver: for (solver in c( "conopt", "filter", "knitro", "lancelot", "loqo", "minos", "mosek", "pennon", "snopt")) print(rneosLP(objective=vec, lower, upper, linCons, control=list(solver=solver, category="nco"))) } ############################################################################### fPortfolio/R/mathprogLP-ampl.R0000644000175100001440000001242512323217770015753 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # ramplLP Rmetrics Interface for AMPL LP solvers # amplLP Convenience wrapper for AMPL LP solvers # amplLPControl AMPL LP control parameter list ############################################################################### ramplLP <- function(objective, lower=0, upper=1, linCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Implements AMPL LP Interface # Arguments: # objective - vec # FUNCTION: # Control List: ctrl <- amplLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Controls: solver <- control$solver project <- control$project inf <- control$inf trace <- control$trace # Objective: vec <- objective # Box Constraints: replicate <- function(x, n) if(length(x) == 1) rep(x, n) else x n <- length(vec) x_L <- replicate(lower, n) x_U <- replicate(upper, n) x_L[is.infinite(x_L)] <- inf*sign(x_L[is.infinite(x_L)]) x_U[is.infinite(x_U)] <- inf*sign(x_U[is.infinite(x_U)]) # Linear Constraints: A <- linCons[[1]] m <- nrow(A) b_L <- replicate(linCons[[2]], m) b_U <- replicate(linCons[[3]], m) b_L[is.infinite(b_L)] <- inf*sign(b_L[is.infinite(b_L)]) b_U[is.infinite(b_U)] <- inf*sign(b_U[is.infinite(b_U)]) # Optimize Portfolio: value <- amplLP(vec, x_L, x_U, A, b_L, b_U, control) # Return Value: value } # ------------------------------------------------------------------------- amplLP <- function( objective, x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Universal function wrapper for AMPL LP solvers # Arguments: # objective - vec # FUNCTION: # Control List: ctrl <- amplLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Control Parameters: project <- control$project solver <- control$solver inf <- control$inf trace <- control$trace # Objective: c <- objective n <- length(vec) m <- nrow(A) # Assign LP Model: .lpAssign(project, c, x_L, x_U, A, b_L, b_U , trace=FALSE) # Run AMPL: command <- paste("ampl -t -vs", paste(project, "run", sep=".")) solve <- system(command, intern=TRUE) # Read AMPL Output File: file <- paste(project, "txt", sep = ".") out <- scan(file, what = character(0), sep="\n", quiet=TRUE) # Get Weights: Index <- (grep(";", out) - 1)[1] splits <- strsplit(paste(out[2:Index], collapse=" "), " ")[[1]] solution <- as.numeric(splits[splits != ""])[seq(2, 2*n, by=2)] Index <- as.numeric(splits[splits != ""])[seq(1, 2*n, by=2)] solution[Index] <- solution # Get Status: status <- strsplit(out[grep("solve_result", out)], split=" ") statusCode <- status[[1]][3] statusMessage <- status[[2]][3] # Get Solver Message: Index <- grep("solve_message", out):length(out) message <- out[Index] # Version: version <- system(paste(solver, "-v"), intern=TRUE) # Compose Results into a List: objective <- (c %*% solution)[[1, 1]] # Return Value: model <- capture.output(amplModelShow(project)) run <- capture.output(amplModelShow(project)) value = list( opt = list(solve=solve, model=model, run=run, out=out), solution = solution, objective = objective, status = statusCode, message = statusMessage, solver = paste("AMPL", solver), version = version) class(value) <- c("solver", "list") value } # ------------------------------------------------------------------------- amplLPControl <- function(solver="ipopt", project="ampl", inf=1e12, trace=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns AMPL LP control parameter list # FUNCTION: # Return Value: list(solver=solver, project=project, inf=inf, trace=trace) } ############################################################################### fPortfolio/R/a-class-fPFOLIOBACKTEST.R0000644000175100001440000000255312323217770016550 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # "fPFOLIOBACKTEST" S4 Portfolio Backtest Class ################################################################################ setClass("fPFOLIOBACKTEST", # A function implemented by Diethelm Wuertz and William Chen # Description: # Represens S4 fPFOLIOBACKTEST Class representation( windows = "list", strategy = "list", smoother = "list", messages = "list") ) ################################################################################ fPortfolio/R/backtest-getBacktestSpec.R0000644000175100001440000002245612323217770017625 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # getWindows Extracts windows slot # getWindowsFun Extracts name of windows function # getWindowsParams Extracts a list of windows specific parameters # getWindowsHorizon Extracts windows horizon # FUNCTION: DESCRIPTION: # getStrategy Extracts strategy slot # getStrategyFun Extracts the name of portfolio strategy function # getStrategyParams Extracts a list of strategy specific parameters # FUNCTION: DESCRIPTION: # getSmoother Extracts the smoother slot # getSmootherFun Extracts the name of the moother function # getSmootherParams Extracts a list of smoothing specific parameters # getSmootherLambda Extracts the smoothing parameter Lambda # getSmootherDoubleSmoothing Extracts setting for double smoothing # getSmootherInitialWeights Extracts the initial weights in the smoothing # getSmootherSkip Extracts the number of skipped months # FUNCTION: DESCRIPTION: # getMessages Extracts the message slot ################################################################################ getWindows.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts Windows slot from an object of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Description: # gets the "model" slot from an object of class 4 # Arguments: # object - an object of class S4 # FUNCTION: # Return Value: getSlot(object, "windows") } # ------------------------------------------------------------------------------ getWindowsFun.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts name of windows function from an object of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getWindows(object)$windows } # ------------------------------------------------------------------------------ getWindowsParams.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts a list of windows specific parameters from an object # of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getWindows(object)$params } # ------------------------------------------------------------------------------ getWindowsHorizon.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts windows horizon from an object of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getWindowsParams(object)$horizon } # ------------------------------------------------------------------------------ getSmoother.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts the smoother slot from an object of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getSlot(object, "smoother") } # ------------------------------------------------------------------------------ getSmootherFun.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts the name of the moother function from an object # of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getSmoother(object)$smoother } # ------------------------------------------------------------------------------ getSmootherParams.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts a list of strategy specific parameters # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getSmoother(object)$params } # ------------------------------------------------------------------------------ getSmootherLambda.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts the smoothing parameter Lambda from an object # of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getSmootherParams(object)$lambda } # ------------------------------------------------------------------------------ getSmootherDoubleSmoothing.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts setting for double smoothing from an object # of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getSmootherParams(object)$doubleSmoothing } # ------------------------------------------------------------------------------ getSmootherInitialWeights.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts the initial weights in the smoothing from an object # of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getSmootherParams(object)$initialWeights } # ------------------------------------------------------------------------------ getSmootherSkip.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts the number of skipped months from an object # of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getSmootherParams(object)$skip } # ------------------------------------------------------------------------------ getStrategy.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts strategy slot from an object of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getSlot(object, "strategy") } # ------------------------------------------------------------------------------ getStrategyFun.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts the name of portfolio strategy function from an object # of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getStrategy(object)$strategy } # ------------------------------------------------------------------------------ getStrategyParams.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts a list of strategy specific parameters from an object # of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getStrategy(object)$params } # ------------------------------------------------------------------------------ getMessages.fPFOLIOBACKTEST <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Extracts the message slot from an object of class fPFOLIOBACKTEST # Arguments: # object - an object of class fPFOLIOBACKTEST # FUNCTION: # Return Value: getSlot(object, "messages") } ################################################################################ fPortfolio/R/utils-NLPgeneral.R0000644000175100001440000004536212410244446016077 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: # require(Rdonlp2) # require(Rsolnp) # require(Rnlminb2) # FUNCTION: # .powellTestNLP # .wright4TestNLP # .boxTestNLP # .wright9TestNLP # .alkylationTestNLP # .entropyTestNLP # .rosensuzukiTestNLP # .sharperatioTestNLP # .rachevratioTestNLP # .boxmarkowitzTestNLP ################################################################################ .powellTestNLP <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: start <- c(-2, 2, 2, -1, -1) fun <- function(x) { exp(x[1]*x[2]*x[3]*x[4]*x[5]) } eqFun <- list( function(x) x[1]*x[1]+x[2]*x[2]+x[3]*x[3]+x[4]*x[4]+x[5]*x[5], function(x) x[2]*x[3]-5*x[4]*x[5], function(x) x[1]*x[1]*x[1]+x[2]*x[2]*x[2]) eqFun.bound <- c(10, 0, -1) ans.donlp = donlp2NLP(start, fun, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.solnp = solnpNLP(start, fun, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.nlminb = nlminb2NLP(start, fun, eqFun = eqFun, eqFun.bound = eqFun.bound) result.par = round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 3) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } # ------------------------------------------------------------------------------ .wright4TestNLP <- function() { # A function implemented by Diethelm Wuertz # nlminb2 does not converge # FUNCTION: start <- c(1, 1, 1, 1, 1) fun <- function(x){ (x[1]-1)^2+(x[1]-x[2])^2+(x[2]-x[3])^3+(x[3]-x[4])^4+(x[4]-x[5])^4} eqFun = list( function(x) x[1]+x[2]*x[2]+x[3]*x[3]*x[3], function(x) x[2]-x[3]*x[3]+x[4], function(x) x[1]*x[5] ) eqFun.bound = c(2+3*sqrt(2), -2+2*sqrt(2), 2) ans.donlp = donlp2NLP(start, fun, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.solnp = solnpNLP(start, fun, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.nlminb = nlminb2NLP(start, fun, eqFun = eqFun, eqFun.bound = eqFun.bound) result.par = round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 3) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } # ------------------------------------------------------------------------------ .boxTestNLP <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: start <- c(1.1, 1.1, 9) fun <- function(x) { -x[1]*x[2]*x[3] } par.lower = rep(1, 3) par.upper = rep(10, 3) eqFun <- list( function(x) 4*x[1]*x[2]+2*x[2]*x[3]+2*x[3]*x[1] ) eqFun.bound = 100 ans.donlp = donlp2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.solnp = solnpNLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.nlminb = nlminb2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) result.par = round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 3) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } # ------------------------------------------------------------------------------ .wright9TestNLP <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: start <- c(1, 1, 1, 1, 1) fun <- function(x){ 10*x[1]*x[4]-6*x[3]*x[2]*x[2]+x[2]*(x[1]*x[1]*x[1])+ 9*sin(x[5]-x[3])+x[5]^4*x[4]*x[4]*x[2]*x[2]*x[2] } ineqFun <- list( function(x) x[1]*x[1]+x[2]*x[2]+x[3]*x[3]+x[4]*x[4]+x[5]*x[5], function(x) x[1]*x[1]*x[3]-x[4]*x[5], function(x) x[2]*x[2]*x[4]+10*x[1]*x[5]) ineqFun.lower = c(-100, -2, 5) ineqFun.upper = c( 20, 100, 100) ans.donlp = donlp2NLP(start, fun, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) ans.solnp = solnpNLP(start, fun, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) ans.nlminb = nlminb2NLP(start, fun, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) result.par = round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 3) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } # ------------------------------------------------------------------------------ .alkylationTestNLP <- function() { # A function implemented by Diethelm Wuertz # solnp does not converge # FUNCTION: start <- c(17.45, 12, 110, 30.5, 19.74, 89.2, 92.8, 8, 3.6, 145.2) fun <- function(x) { -0.63*x[4]*x[7]+50.4*x[1]+3.5*x[2]+x[3]+33.6*x[5] } par.lower <- c( 0, 0, 0, 10, 0, 85, 10, 3, 1, 145) par.upper <- c(20, 16, 120, 50, 20, 93, 95,12, 4, 162) eqFun <- list( function(x) 98*x[3]-0.1*x[4]*x[6]*x[9]-x[3]*x[6], function(x) 1000*x[2]+100*x[5]-100*x[1]*x[8], function(x) 122*x[4]-100*x[1]-100*x[5]) eqFun.bound = c(0, 0, 0) ineqFun <- list( function(x) (1.12*x[1]+0.13167*x[1]*x[8]-0.00667*x[1]*x[8]*x[8])/x[4], function(x) (1.098*x[8]-0.038*x[8]*x[8]+0.325*x[6]+57.25)/x[7], function(x) (-0.222*x[10]+35.82)/x[9], function(x) (3*x[7]-133)/x[10]) ineqFun.lower = c( 0.99, 0.99, 0.9, 0.99) ineqFun.upper = c(100/99, 100/99, 10/9, 100/99) ans.donlp = donlp2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) ans.solnp = solnpNLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) ans.nlminb = nlminb2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) result.par = round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 3) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } # ------------------------------------------------------------------------------ .entropyTestNLP <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: set.seed(1953) start <- runif(10, 0, 1) fun <- function(x) { m = length(x) f = -sum(log(x)) vnorm = sum((x-1)^2)^(1/2) f - log(vnorm + 0.1) } par.lower <- rep(0, 10) eqFun <- list( function(x) sum(x) ) eqFun.bound <- 10 ans.donlp = donlp2NLP(start, fun, par.lower = par.lower, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.solnp = solnpNLP(start, fun, par.lower = par.lower, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.nlminb = nlminb2NLP(start, fun, par.lower = par.lower, eqFun = eqFun, eqFun.bound = eqFun.bound) result.par = round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 3) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } # ------------------------------------------------------------------------------ .rosensuzukiTestNLP <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: start <- c(1, 1, 1, 1) fun <- function(x) x[1]*x[1]+x[2]*x[2]+2*x[3]*x[3]+x[4]*x[4]-5*x[1]-5*x[2]-21*x[3]+7*x[4] ineqFun <- list( function(x) 8-x[1]*x[1]-x[2]*x[2]-x[3]*x[3]-x[4]*x[4]-x[1]+x[2]-x[3]+x[4], function(x) 10-x[1]*x[1]-2*x[2]*x[2]-x[3]*x[3]-2*x[4]*x[4]+x[1]+x[4], function(x) 5-2*x[1]*x[1]-x[2]*x[2]-x[3]*x[3]-2*x[1]+x[2]+x[4] ) ineqFun.lower <- rep( 0, 3) ineqFun.upper <- rep(10, 3) ans.donlp = donlp2NLP(start, fun, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) ans.solnp = solnpNLP(start, fun, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) ans.nlminb = nlminb2NLP(start, fun, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) result.par = round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 3) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } #------------------------------------------------------------------------------- .sharperatioTestNLP <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: dataSet <- data("LPP2005REC", package="timeSeries", envir=environment()) LPP2005REC <- get(dataSet, envir=environment()) ret <- as.matrix(LPP2005REC[,2:7]) Mean <- colMeans(ret) Cov <- cov(ret) start <- rep(1/6, times = 6) fun <- function(x) { return = (Mean %*% x)[[1]] risk = sqrt ( (t(x) %*% Cov %*% x)[[1]] ) -return/risk } par.lower <- rep(0, 6) par.upper <- rep(1, 6) eqFun <- list( function(x) sum(x) ) eqFun.bound = 1 ans.donlp <- donlp2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound ) ans.solnp <- solnpNLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.nlminb <- Rnlminb2::nlminb2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) result.par = round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 3) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) result.par <- 100*round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 4) result.fun <- c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } # ------------------------------------------------------------------------------ .rachevratioTestNLP <- function() { # A function implemented by Diethelm Wuertz # Note: # sonlp2 and nlminb do not converge! # FUNCTION: dataSet <- data("LPP2005REC", package="timeSeries", envir=environment()) LPP2005REC <- get(dataSet, envir=environment()) ret = as.matrix(LPP2005REC[, 2:7]) Mean = colMeans(ret) Cov = cov(ret) set.seed(1953) r = runif(6) start <- r/sum(r) start <- rep(1/6, times = 6) .VaR <- function(x) { quantile(x, probs = 0.05, type = 1) } .CVaR <- function(x) { VaR = .VaR(x) VaR - 0.5 * mean(((VaR-ret) + abs(VaR-ret))) / 0.05 } fun <- function(x) { port = as.vector(ret %*% x) ans = (-.CVaR(-port) / .CVaR(port))[[1]] ans} par.lower = rep(0, 6) par.upper = rep(1, 6) eqFun <- list( function(x) sum(x) ) eqFun.bound = 1 ans.donlp = donlp2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.solnp = solnpNLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.nlminb = nlminb2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) result.par = 100*round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 4) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } #------------------------------------------------------------------------------- .boxmarkowitzTestNLP <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: dataSet <- data("LPP2005REC", package="timeSeries", envir=environment()) LPP2005REC <- get(dataSet, envir=environment()) ret <- 100 * as.matrix(LPP2005REC[, 2:7]) Mean <- colMeans(ret) Cov <- cov(ret) targetReturn <- mean(Mean) start <- rep(1/6, times = 6) objective <- function(x) { risk <- (t(x) %*% Cov %*% x)[[1]] risk } fun <- objective par.lower <- rep(0, 6) par.upper <- rep(1, 6) eqFun <- list( function(x) sum(x), function(x) (Mean %*% x)[[1]] ) eqFun.bound = c(1, targetReturn) ans.donlp = donlp2NLP(start, objective, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.solnp = solnpNLP(start, objective, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) ans.nlminb = nlminb2NLP(start, objective, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound) result.par <- 100*round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 4) result.fun <- c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } #------------------------------------------------------------------------------- .groupmarkowitzTestNLP <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: dataSet <- data("LPP2005REC", package="timeSeries", envir=environment()) LPP2005REC <- get(dataSet, envir=environment()) ret <- 100 * as.matrix(LPP2005REC[, 2:7]) Mean <- colMeans(ret) Cov <- cov(ret) targetReturn <- mean(Mean) start <- rep(1/6, times = 6) start[1]+start[4] start[2]+start[5]+start[6] # Must be feasible for nlminb !!! start2 <- c(0, 0, 0.3, 0.3, 0, 0.4) start2 <- start/sum(start2) sum(start2) start2[1]+start2[4] start2[2]+start2[5]+start2[6] fun <- function(x) { risk = (t(x) %*% Cov %*% x)[[1]] risk } par.lower <- rep(0, 6) par.upper <- rep(1, 6) eqFun <- list( function(x) sum(x), function(x) (Mean %*% x)[[1]] ) eqFun.bound = c(1, targetReturn) ineqFun <- list( function(x) x[1]+x[4], function(x) x[2]+x[5]+x[6]) ineqFun.lower <- c( 0.3, 0.0) ineqFun.upper <- c( 1.0, 0.6) ans.donlp = donlp2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) ans.solnp = solnpNLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) ans.nlminb = nlminb2NLP(start, fun, par.lower = par.lower, par.upper = par.upper, eqFun = eqFun, eqFun.bound = eqFun.bound, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper) result.par = 100*round(rbind( ans.donlp$solution, ans.solnp$solution, ans.nlminb$solution), 4) result.fun = c( fun(ans.donlp$solution), fun(ans.solnp$solution), fun(ans.nlminb$solution)) cbind(result.par, result.fun) } ################################################################################ fPortfolio/R/a-class-fPFOLIODATA.R0000644000175100001440000000226312323217770016057 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # 'fPFOLIODATA' S4 Portfolio Data Class ################################################################################ setClass("fPFOLIODATA", representation( data = "list", statistics = "list", tailRisk = "list") ) ################################################################################ fPortfolio/R/utils-amplLibrary.R0000644000175100001440000001373412323217770016367 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # .lpAssign Assigns linear programming model # .qpAssign Assigns quadratic programming model ################################################################################ .lpAssign <- function(project, c, x_L, x_U, A, b_L, b_U, solver="ipopt", trace=FALSE) { # A function written by Diethelm Wuertz # Description: # Assigns LP Model # Arguments: # project - project name # FUNCTION: # Settings: n <- length(c) m <- nrow(A) # Write AMPL Model File: amplModelOpen(project) model <- c( "param n ;", "param m ;", "param c{1..n} ;", "param x_L{1..n} ;", "param x_U{1..n} ;", "param A{1..m, 1..n} ;", "param b_L{1..m} ;", "param b_U{1..m} ;", "var x{1..n};", "minimize Objective: sum {i in 1..n} x[i]*c[i] ;", "s.t. lower {i in 1..n}: x[i] >= x_L[i] ;", "s.t. upper {i in 1..n}: x[i] <= x_U[i] ;", "s.t. linLower {j in 1..m}: sum{i in 1..n} A[j, i]*x[i] >= b_L[j] ;", "s.t. linUpper {j in 1..m}: sum{i in 1..n} A[j, i]*x[i] <= b_U[j] ;", NULL) amplModelAdd(model, project) if (trace) amplModelShow(project) # Write AMPL Data File: amplDataOpen(project) amplDataAddValue (data="n", value=n, project) amplDataAddValue (data="m", value=m, project) amplDataAddVector(data="c", vector=c, project) amplDataAddVector(data="x_L", vector=x_L, project) amplDataAddVector(data="x_U", vector=x_U, project) amplDataAddMatrix(data="A", matrix=A, project) amplDataAddVector(data="b_L", vector=b_L, project) amplDataAddVector(data="b_U", vector=b_U, project) if (trace) amplDataShow(project) # Write AMPL RUN File: amplRunOpen(project) run <- c( paste("reset ;"), paste("option solver ", solver, " ;", sep = ""), paste("model ", project, ".mod ;", sep = ""), paste("data ", project, ".dat ;", sep = ""), paste("solve ;"), paste("display x > ", project, ".txt ;", sep = ""), paste("display solve_result_num > ", project, ".txt ;", sep = ""), paste("display solve_result > ", project, ".txt ;", sep = ""), paste("display solve_message > ", project, ".txt ;", sep = ""), paste("exit ;") ) amplRunAdd(run, project) if (trace) amplRunShow(project) # Return Value: invisible() } # ----------------------------------------------------------------------------- .qpAssign <- function(project, c, F, x_L, x_U, A, b_L, b_U, solver="ipopt", trace=FALSE) { # A function written by Diethelm Wuertz # Description: # Assigns LP Model # Arguments: # project - project name # FUNCTION: # Settings: n <- length(c) m <- nrow(A) # Write AMPL Model File: amplModelOpen(project) model <- c( "param n ;", "param m ;", "param c{1..n} ;", "param F{1..n, 1..n} ;", "param x_L{1..n} ;", "param x_U{1..n} ;", "param A{1..m, 1..n} ;", "param b_L{1..m} ;", "param b_U{1..m} ;", "var x{1..n};", "minimize Risk: sum {i in 1..n} x[i]*c[i] + 0.5*sum {i in 1..n} sum{j in 1..n} x[i]*F[i,j]*x[j] ;", "s.t. lower {i in 1..n}: x[i] >= x_L[i] ;", "s.t. upper {i in 1..n}: x[i] <= x_U[i] ;", "s.t. linLower {j in 1..m}: sum{i in 1..n} A[j, i]*x[i] >= b_L[j] ;", "s.t. linUpper {j in 1..m}: sum{i in 1..n} A[j, i]*x[i] <= b_U[j] ;", NULL) amplModelAdd(model, project) if (trace) amplModelShow(project) # Write AMPL Data File: amplDataOpen(project) amplDataAddValue (data="n", value=n, project) amplDataAddValue (data="m", value=m, project) amplDataAddVector(data="c", vector=c, project) amplDataAddMatrix(data="F", matrix=F, project) amplDataAddVector(data="x_L", vector=x_L, project) amplDataAddVector(data="x_U", vector=x_U, project) amplDataAddMatrix(data="A", matrix=A, project) amplDataAddVector(data="b_L", vector=b_L, project) amplDataAddVector(data="b_U", vector=b_U, project) if (trace) amplDataShow(project) # Write AMPL RUN File: amplRunOpen(project) run <- c( paste("reset ;"), paste("option solver ", solver, " ;", sep = ""), paste("model ", project, ".mod ;", sep = ""), paste("data ", project, ".dat ;", sep = ""), paste("solve ;"), paste("display x > ", project, ".txt ;", sep = ""), paste("display solve_result_num > ", project, ".txt ;", sep = ""), paste("display solve_result > ", project, ".txt ;", sep = ""), paste("display solve_message > ", project, ".txt ;", sep = ""), paste("exit ;") ) amplRunAdd(run, project) if (trace) amplRunShow(project) # Return Value: invisible() } ################################################################################ fPortfolio/R/object-getData.R0000644000175100001440000000577312424415114015566 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # getData Extracts data slot # getSeries Extracts assets series data # getNAssets Extracts number of assets from data # getUnits Extracts assets names from data # FUNCTION: DESCRIPTION: # getStatistics Extracts statistics slot # getMean Extracs mean from statistics # getCov Extracs covariance Sigma from statistics # getMu Extracs mu from statistics # getSigma Extracs Sigma from statistics # getEstimator Extracts estimator from # FUNCTION: DESCRIPTION: # getTailRisk Extracts tailRisk slot ################################################################################ # fPFOLIODATA: # data = list( # series # nAssets # names) # statistics = list( # mean, # Cov, # mu, # Sigma, # estimator) # tailRisk = list() # ------------------------------------------------------------------------------t getData.fPFOLIODATA <- function(object) object@data # Extracts the @data slot from a fPFOLIODATA object getSeries.fPFOLIODATA <- function(object) object@data$series getNAssets.fPFOLIODATA <- function(object) object@data$nAssets getUnits.fPFOLIODATA <- function(x) x@data$names # ------------------------------------------------------------------------------ getStatistics.fPFOLIODATA <- function(object) object@statistics # Extracts the @statistics slot from a fPFOLIODATA object getMean.fPFOLIODATA <- function(object) object@statistics$mean getCov.fPFOLIODATA <- function(object) object@statistics$Cov getEstimator.fPFOLIODATA <- function(object) object@statistics$estimator getMu.fPFOLIODATA <- function(object) object@statistics$mu getSigma.fPFOLIODATA <- function(object) object@statistics$Sigma # ------------------------------------------------------------------------------ getTailRisk.fPFOLIODATA <- function(object) object@tailRisk # Extracts the @tailRisk slot from a fPFOLIODATA object ################################################################################ fPortfolio/R/zzz.R0000644000175100001440000000501613202336751013600 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ .onAttach <- function(libname, pkgname) { # do whatever needs to be done when the package is loaded # some people use it to bombard users with # messages using # packageStartupMessage( "\n" ) # packageStartupMessage( "Rmetrics Package fPortfolio" ) # packageStartupMessage( "Portfolio Optimization" ) # packageStartupMessage( "Copyright (C) 2005-2014 Rmetrics Association Zurich" ) # packageStartupMessage( "Educational Software for Financial Engineering and Computational Science" ) # packageStartupMessage( "Rmetrics is free software and comes with ABSOLUTELY NO WARRANTY." ) # packageStartupMessage( "https://www.rmetrics.org --- Mail to: info@rmetrics.org" ) } ############################################################################### .onLoad <- function(libname, pkgname) { if(!is.numeric(timeDate::getRmetricsOptions("length.print"))) timeDate::setRmetricsOptions(length.print = 5) timeDate::setRmetricsOptions(.x.save = NA) eval(attach <- function(what) base::attach(what, warn.conflicts=FALSE), envir=.GlobalEnv) } # Startup Mesage and Desription: # MSG <- if(getRversion() >= "2.5") packageStartupMessage else message # dsc <- packageDescription(pkg) # if(interactive() || getOption("verbose")) { # title <- paste(strsplit(dsc$Title, split = "-")[1:2]) # MSG(paste( # "\nPackage ", pkg, " (", dsc$Version, ") loaded.\n", # dsc$Title, "\n", # dsc$Copyright, ", ", dsc$License, "\n", # dsc$Author, "\n", # dsc$URL, "\n", sep="")) # } ############################################################################### fPortfolio/R/backtest-methodsShow.R0000644000175100001440000000544612323217770017056 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # show.fPFOLIOBACKTEST Print method for 'fPFOLIOBACKTEST' objects ################################################################################ setMethod("show", "fPFOLIOBACKTEST", function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # S4 Print Method for an object of class "fPFOLIODATA" # Arguments: # object - an object of class "fPFOLIOSPEC" # FUNCTION: # Windows: cat("\nBacktest Specification:\t") cat("\n\n Windows Function: ", object@windows$windows) cat("\n Windows Params:\t") winParams <- object@windows$params paramNames <- names(winParams) chars <- nchar(paramNames) for (i in seq(along = winParams)){ cat("\n -", paramNames[i], paste(rep(" ", 24-nchar(paramNames[i])),collapse = ""), as.character(winParams[[i]])) } # Strategy: cat("\n\n Strategy Function: ", object@strategy$strategy) cat("\n Strategy Params:\t") strategyParams <- object@strategy$params paramNames <- names(strategyParams) for (i in seq(along = strategyParams)){ cat("\n -", paramNames[i], paste(rep(" ", 24-nchar(paramNames[i])),collapse = ""), as.character(strategyParams[[i]])) } # Smoother: cat("\n\n Smoother Function: ", object@smoother$smoother) cat("\n Smoother Params:\t") smootherParams <- object@smoother$params paramNames <- names(smootherParams) for (i in seq(along = smootherParams)){ cat("\n -", paramNames[i], paste(rep(" ", 24-nchar(paramNames[i])),collapse = ""), substr(as.character(smootherParams[[i]]), 1, 5)) } # Messages: cat("\n\n Messages: ", unlist(object@messages), "\n\n") # Return Value: invisible(object) }) ################################################################################ fPortfolio/R/risk-ternaryMap.R0000644000175100001440000003034112323217770016034 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # ternaryMap Displays a risk map for ternary portfolios # ternaryFrontier Plots the efficient frontier of a ternary portfolio # FUNCTION: DESCRIPTION: # riskMap normalVaR risk map function called from ternaryMap() # maxddMap max Drawdown risk map function called from ternaryMap() # FUNCTION: DESCRIPTION: # ternaryWeights Creates a set of ternary weights # ternaryCoord Computes x, y coordinates from weights # ternaryPoints Adds points to a ternary map plot ############################################################################### ternaryMap <- function(data, FUN=NULL, ..., locator=FALSE, N=41, palette=topo.colors, nlevels=11) { # A function implemented by Diethelm Wuertz # Description: # Displays a risk map for ternary portfolios # Arguments: # data - a ternary 'timeSeries' object of financial returns # FUN - the map function # ... - optional arguments passed to function FUN # locator - a logical flag to activate the locator # N - number of bins # palette - color palette # nlevels - number of contour levels # Examples: # ternaryMap(data=SWX.RET[, 1:3]) # ternaryMap(data=SWX.RET[, 1:3], FUN=.riskTest, locator=TRUE) # ternaryMap(data=SWX.RET[, 1:3], FUN=.maxddTest) # FUNCTION: # N=41; palette=topo.colors; nlevels=11; FUN <- NULL; ... <- NULL # Surface Function: if (is.null(FUN)) FUN <- function(data, weights, ...) var(weights) fun <- match.fun(FUN) # Grid Points: s <- sqrt(3)/2 x <- seq(0, 1, length=N) y <- s * x # Surface Values: G <- matrix(NA, N, N) xy <- W <- NULL for (j in 1:N) { w3 <- y[j] / s for (i in 1:N) { w2 <- x[i] - w3/2 w1 <- 1 - w2 - w3 if (w1 >= -1/N && w2 >= -1/N) { # if (w1 >= 0 && w2 >= 0) { w <- c(w1, w2, w3) xy <- rbind(xy, c(x[i], y[j])) W <- rbind(W, w) G[i, j] <- ans <- fun(data, w, ...) } } } surface <- list(x=x, y=y/s, z=G) x <- surface$x y <- surface$y z <- surface$z # Color Settings: colors <- .scaledColors(surface, palette = palette, nlevels = nlevels) levels <- colors$levels palette <- colors$palette # Image Ranges: yOffset <- 0.025 * diff(range(y)) yLim <- c(min(y) - yOffset, max(y) + yOffset) xOffset <- 0.1 * diff(range(x)) xLim <- c(min(x) - xOffset/4, max(x) + xOffset) # Filled Contour Plot: image(x, y, z, xlim = xLim, ylim = yLim, xlab = "", ylab = "", col = "white") grid() # DW # .Internal(filledcontour()) no longer works on 3.0. # .Internal(filledcontour( # as.double(x), as.double(y), z, # as.double(levels), col = palette)) # Use instead: graphics::.filled.contour( x = as.double(x), y = as.double(y), z = z, levels = as.double(levels), col = palette) contour(x, y, z, add = TRUE, levels = signif(levels, 3)) d <- 3/N polygon(c(1, 1+d, 0.5+d, 0.5, 1), c(0, 0, s, s, 0)/s, col="white", border="white") polygon(c(0, 0.5, 0.5-d, -d, 0), c(0, s, s, 0, 0)/s, col="white", border="white") box(col = "white") # Please do not Remove: mtext("Rmetrics", 4, col="grey", adj=0, cex=0.7) # Grid Lines: for(k in 1:10) lines(c(k*0.1, k*0.05), c(0, k*0.1), col="grey", lty=3) for(k in 1:10) lines(c(1-k*0.1, 1-k*0.05), c(0, k*0.1), col="grey", lty=3) for(k in 1:9) lines(c(k*0.05, 1-k*0.05), c(k*0.1, k*0.1), col="grey", lty=3) # Add Legend: cs <- cumsum(levels) css <- (cs - min(cs))/diff(range(cs)) css <- 0.95 * css + 0.025 cy <- min(y) + css * diff(range(y)) cx <- rep(xLim[2] - 0.1 * xOffset, length(cy)) lines(cx, cy, lwd = 3) for (i in 1:(nlevels - 1)) lines(c(cx[i], cx[i + 1]), c(cy[i], cy[i + 1]), lwd = 3, col = palette[i]) for (i in 1:nlevels) points(cx[i], cy[i], pch = 16, cex = 1.1, col = "black") textOffset <- c(-5e-04, 5e-04, 8e-04, 8e-04, rep(0, 7)) text(cx, cy + textOffset, as.character(signif(levels, 2)), pos = 2, cex = 0.8) # Decoration: pointCex <- 2.5 textCex <- 0.5 # EfficientFrontier: frontier <- portfolioFrontier(data) weights <- getWeights(frontier@portfolio) xy <- cbind(x=weights[, 2]+weights[, 3]/2, y=weights[, 3]) lines(xy, col="brown", lwd=3) # Global Minimum Variance Portfolio: weights<- getWeights(minvariancePortfolio(data)) xy <- c(x=weights[2]+weights[3]/2, y=weights[3]) points(xy[1], xy[2], pch=19, cex=pointCex, col="red") text(xy[1], xy[2], "MVP", font=2, col="white", cex=textCex) # Tangency Portfolio: weights <- getWeights(tangencyPortfolio(data)) xy <- c(x=weights[2]+weights[3]/2, y=weights[3]) points(xy[1], xy[2], pch=19, cex=pointCex, col="orange") text(xy[1], xy[2], "TGP", font=2, col="white", cex=textCex) # Equal Weights: xy <- rbind(c(1/3+1/6, 1/3)) points(xy, pch=19, cex=pointCex, col="brown") text(xy, "EWP", font=2, col="white", cex = textCex) # Individual Assets: xy = rbind(c(0,0), c(1,0), c(1/2, 1)) points(xy, pch=19, cex=pointCex, col="black") text(xy, colnames(data), font = 2, col = "white", cex = textCex) # Locator: if (locator) { for (i in 1:512) { ans <- locator(n = 1, type = "p", pch=10) w3 <- ans$y w2 <- ans$x - w3/2 w <- round(c(w1=1-w2-w3, w2, w3), 2) names(w) <- colnames(data) total <- sum(w) names(total) <- "Total" z <- signif(fun(data, w, ...), 3) ans <- data.frame(rbind(c(w, total, z))) rownames(ans) <- "Composition" print(ans) } } # Return Value: invisible() } # ----------------------------------------------------------------------------- ternaryFrontier <- function(data, locator=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Plots the efficient frontier of a ternary map # Arguments: # data - a ternary 'timeSeries' object of financial returns # locator - a logical flag to activate the locator # Example: # ternaryFrontier(SWX.RET[, 1:3], locator=TRUE) # FUNCTION: # Long Only Markowitz Portfolio: polygon <- markowitzHull(data) object <- attr(polygon, "frontier") # Plot Range: offset <- 0.1 xlim <- c(0, max(sqrt(diag(getCov(object))))) Xlim <- c(xlim[1] - diff(xlim) * offset, xlim[2] + diff(xlim) * offset) ylim <- range(getMean(object)) Ylim <- c(ylim[1] - diff(ylim) * offset, ylim[2] + diff(ylim) * offset) # Get Points and Add Frontier: frontierPlot(object, auto=FALSE, xlim=Xlim, ylim=Ylim, pch=19, labels=FALSE) polygon(polygon, col="grey", border="grey") points(frontierPoints(object, frontier="upper"), pch=19) box(col="white") grid() # Please do not Remove: mtext("Rmetrics", 4, col="grey", adj=0, cex=0.7) # Zero Axis Lines: abline(h = 0, col = "grey") abline(v = 0, col = "grey") # Decoration Settings: pointCex <- 2.5 textCex <- 0.5 # Add Global Minimum Variance Portfolio: xy <- minvariancePoints( object, auto=FALSE, pch=19, col="red", cex=pointCex) text(xy[1], xy[2], "MVP", font=2, col="white", cex=textCex) # Add Tangency Portfolio for zero risk free Rate: tangencyLines(object, auto=FALSE, col="blue") xy <- tangencyPoints( object, auto=FALSE, pch=19, col="blue", cex=pointCex) text(xy[1], xy[2], "TGP", font=2, col="white", cex=textCex) # Add Equal Weights Portfolio: xy <- equalWeightsPoints( object, auto=FALSE, pch=19, col="brown", cex=pointCex) text(xy[1], xy[2], "EWP", font=2, col="white", cex=textCex) # Add Two Assets Portfolios: xy <- singleAssetPoints( object, auto=FALSE, pch=19, col="black", cex=pointCex) text(xy[,1], xy[,2], colnames(data), font=2, col="white", cex=textCex) # Add Sharpe Ratio: sharpeRatioLines(object, auto=FALSE, col="orange", lwd=2, pch=19) # Locator: if (locator) { for (i in 1:512) { ans <- locator(n = 1, type = "p", pch=10) Risk <- ans$x Return <- ans$y SharpeRatio <- ans$y/ans$x ans <- data.frame(rbind(c(Risk, Return, SharpeRatio))) colnames(ans) <- c("Risk", "Return", "SharpeRatio") rownames(ans) <- "Portfolio" print(signif(ans, 3)) } } # Retirn Value: invisible(object) } # ############################################################################# riskMap <- function(data, weights) { # Description: # normalVaR risk map function called from ternaryMap() # FUNCTION: # Map: tS <- pfolioReturn(data, weights=as.vector(weights)) ans <- normalVaR(tS) names(ans) <- "normalVaR" # Return Value: ans } # ----------------------------------------------------------------------------- maxddMap <- function(data, weights) { # Description: # Max Drawdown map function called from ternaryMap() # FUNCTION: # Map: tS <- pfolioReturn(data, weights=as.vector(weights)) ans <- colMins(tS) names(ans) <- "maxdd" # Return Value: ans } # ############################################################################# # Utility Functions: ternaryWeights <- function(n=21) { # A function implemented by Diethelm Wuertz # Description: # Returns a set of ternary weights # Arguments: # n - number of bins # Example: # ternaryWeights() # FUNCTION: # Settings: eps <- sqrt(.Machine$double.eps) # Creates a set of ternary weights W <- seq(0, 1, length=n) W1 <- rep(W, times = length(W)) W2 <- rep(W, each = length(W)) W3 <- 1 - W1 - W2 W3[abs(W3) < eps] <- 0 W <- cbind(W1, W2, W3) weights <- W[W1 + W2 <= 1, ] # Return Value: weights } # ----------------------------------------------------------------------------- ternaryCoord <- function(weights) { # A function implemented by Diethelm Wuertz # Description: # Returns x,y Coordinates of weights triangle # Example: # ternaryCoord(ternaryWeights()) # FUNCTION: # Computexs x, y coordinates from weights x <- 1 - weights[,1] - weights[, 2]/2 y <- sqrt(3) * weights[, 2] /2 # Return Value: cbind(x=x, y=y) } # ----------------------------------------------------------------------------- ternaryPoints <- function(weights, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds points to a ternary map plot # Example: # ternaryPoints(ternaryWeights()) # FUNCTION: # Transpose in the case of a single weight if(is.null(dim(weights))) weights <- t(weights) # Adds points to a ternary map coord <- ternaryCoord(weights) points(coord, ...) # Return Value: invisible() } ############################################################################### fPortfolio/R/a-class-fPFOLIOCON.R0000644000175100001440000000415612323217770015770 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # 'fPORTFOLIOCON' S4 Portfolio Constraints Class ################################################################################ setClass("fPFOLIOCON", representation( # Function Implemented by Diethelm Wuertz # Constraints expressed by strings # LongOnly, Short, Full, ... stringConstraints = "character", # BoxConstraints: minWConstraints = "numeric", maxWConstraints = "numeric", # Group Constraints: eqsumWConstraints = "matrix", minsumWConstraints = "matrix", maxsumWConstraints = "matrix", # Covariance Risk Budget Constraints: minBConstraints = "numeric", maxBConstraints = "numeric", # Nonlinear Constraints: listFConstraints = "list", minFConstraints = "numeric", maxFConstraints = "numeric", # Buyin Constraints: minBuyinConstraints = "numeric", maxBuyinConstraints = "numeric", # Cardinality Constraints: nCardConstraints = "integer", minCardConstraints = "numeric", maxCardConstraints = "numeric") ) ################################################################################ fPortfolio/R/plot-weightsPies.R0000644000175100001440000003252312422702546016217 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # weightsPie Plots a pie of portfolio weights # weightedReturnsPie Plots a pie of weighted means # covRiskBudgetsPie Plots a pie of covariance risk budgets # tailRiskBudgetsPie Plots a pie of copulae tail risk budgets ################################################################################ weightsPie <- function(object, pos = NULL, labels = TRUE, col = NULL, box = TRUE, legend = TRUE, radius = 0.8, ...) { # A function implemented by Diethelm Wuertz and Oliver Greshake # Description: # Plots a Pie Chart of Weigths # Arguments: # object - an object of class 'fPORTFOLIO'. # pos - a numeric value, determining the position on the efficient # frontier plotting the pie, by default NULL, i.e. expecting # an object having only one set of weights like the tangency # portfolio. # box - a logical value, determining whether a frame (box) should # be plotted around the pie, by default TRUE. # col - a color palette, by default the rainbow palette. # legend - a logical value, determining whether a legend with # the names of the assets should be plotted, by default TRUE. # Example: # weightsPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec())) # title(main = "Tangency Portfolio Weights") # FUNCTION: # Default Settings: Title <- "Weights" if (is.null(col)) col <- seqPalette(getNAssets(object), "Blues") if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7 # Get Weights: if (is.null(pos)) { Weights <- getWeights(object@portfolio) } else { Weights <- getWeights(object@portfolio)[pos, ] } X <- Weights # Check for Negative Pie Segments: nX <- getNAssets(object) Sign <- rep("+", nX) Sign[(1:nX)[X < 0]] <- "-" absX <- abs(X) Index <- (1:nX)[X > 0] # Take care of labels, they are also used by the function pie(): if (!is.logical(labels)) { Names <- pieLabels <- labels labels <- FALSE } else { Names <- pieLabels <- object@data@data$names } # Pie Chart: col <- col[Index] legendAssets <- Names[Index] Labels <- paste(Names, Sign) Labels = Labels[X > 0] Y <- X[X > 0] # Plot: if (labels) { pie(Y, labels = Labels, col = col, radius = radius, cex = CEX) } else { pie(Y, labels = pieLabels, col = col, radius = radius, ...) } # Add Title: if (labels) mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1) # Add Info: if (labels) { mtext(paste(getType(object), "|", getSolver(object)), side = 4, adj = 0, col = "grey", cex = 0.7) } # Add Legend: if (legend) { legend("topleft", legend = legendAssets, bty = "n", cex = CEX, fill = col) legendY <- as.character(round(100*Y, digits = 1)) legendY <- paste(Sign[Index], legendY, sep = "") legendY <- paste(legendY, "%") legend("topright", legend = legendY, bty = "n", cex = CEX, fill = col) } # Add Box: if (box) box() # Return Value: invisible(Y) } # ------------------------------------------------------------------------------ weightedReturnsPie <- function(object, pos = NULL, labels = TRUE, col = NULL, box = TRUE, legend = TRUE, radius = 0.8, ...) { # A function implemented by Diethelm Wuertz and Oliver Greshake # Description: # Adds a pie plot of the weights # Arguments: # object - an object of class 'fPORTFOLIO'. # pos - a numeric value, determining the position on the efficient # frontier plotting the pie, by default NULL, i.e. expecting # an object having only one set of weights like the tangency # portfolio. # box - a logical value, determining whether a frame (box) should # be plotted around the pie, by default TRUE. # col - a color palette, by default the rainbow palette. # legend - a logical value, determining whether a legend with # the names of the assets should be plotted, by default TRUE. # Example: # attributesPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec())) # title(main = "Tangency Portfolio Weights") # FUNCTION: # Default Settings: Title <- "Weighted Returns" if (is.null(col)) col <- seqPalette(getNAssets(object), "Blues") if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7 # Get Weights: if (is.null(pos)) { Weights <- getWeights(object@portfolio) } else { Weights <- getWeights(object@portfolio)[pos, ] } Returns = getStatistics(object)$mu X <- Weights * Returns # Check for Negative Pie Segments: nX <- getNAssets(object) Sign <- rep("+", nX) Sign[(1:nX)[X < 0]] <- "-" absX <- abs(X) Index <- (1:nX)[X > 0] # Take care of labels, they are also used by the function pie(): if (!is.logical(labels)) { Names <- pieLabels <- labels labels <- FALSE } else { Names <- pieLabels <- object@data@data$names } # Pie Chart: col <- col[Index] legendAssets <- Names[Index] Labels <- paste(Names, Sign) Labels <- Labels[X > 0] Y <- X[X > 0] # Plot: if (labels) { pie(Y, labels = Labels, col = col, radius = radius, cex = CEX) } else { pie(Y, labels = pieLabels, col = col, radius = radius, ...) } # Add Title: if (labels) mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1) # Add Info: if (labels) { mtext(paste(getType(object), "|", getSolver(object)), side = 4, adj = 0, col = "grey", cex = 0.7) } # Add Legend: if (legend) { legend("topleft", legend = legendAssets, bty = "n", cex = CEX, fill = col) legendY = as.character(round(100*Y, digits = 1)) legendY = paste(Sign[Index], legendY, sep = "") legendY = paste(legendY, "%") legend("topright", legend = legendY, bty = "n", cex = CEX, fill = col) } # Add Box: if (box) box() # Return Value: invisible(Y) } # ------------------------------------------------------------------------------ covRiskBudgetsPie <- function(object, pos = NULL, labels = TRUE, col = NULL, box = TRUE, legend = TRUE, radius = 0.8, ...) { # A function implemented by Diethelm Wuertz and Oliver Greshake # Arguments: # object - an object of class 'fPORTFOLIO'. # pos - a numeric value, determining the position on the efficient # frontier plotting the pie, by default NULL, i.e. expecting # an object having only one set of weights like the tangency # portfolio. # box - a logical value, determining whether a frame (box) should # be plotted around the pie, by default TRUE. # col - a color palette, by default the rainbow palette. # legend - a logical value, determining whether a legend with # the names of the assets should be plotted, by default TRUE. # Description: # Plots a Pie Chart of Risk Budgets # Arguments: # object - an object of class 'fPORTFOLIO' # col - a color palette, by default the rainbow palette # Example: # riskBudgetsPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec())) # title(main = "Tangency Portfolio Weights") # FUNCTION: # Default Settings: Title = "Covariance Risk Budgets" if (is.null(col)) col <- seqPalette(getNAssets(object), "Blues") if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX <- 0.9 else CEX <- 0.7 # Get Cov Risk Budgets: if (is.null(pos)) { X <- getCovRiskBudgets(object@portfolio) } else { X <- getCovRiskBudgets(object@portfolio)[pos, ] } # Check for Negative Pie Segments: nX <- getNAssets(object) Sign <- rep("+", nX) Sign[(1:nX)[X < 0]] <- "-" absX <- abs(X) Index <- (1:nX)[X > 0] # Take care of labels, they are also used by the function pie(): if (!is.logical(labels)) { Names <- pieLabels <- labels labels <- FALSE } else { Names <- pieLabels <- object@data@data$names } # Legend Labels: col <- col[Index] legendAssets <- Names[Index] Labels <- paste(Names, Sign) Labels <- Labels[X > 0] Y <- X[X > 0] # Plot: if (labels) { pie(Y, labels = Labels, col = col, radius = radius, cex = CEX) } else { pie(Y, labels = pieLabels, col = col, radius = radius, ...) } # Add Title: if (labels) mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1) # Add Info: if (labels) { mtext(paste(getType(object), "|", getSolver(object)), side = 4, adj = 0, col = "grey", cex = 0.7) } # Add Legend: if (legend) { legend("topleft", legend = legendAssets, bty = "n", cex = CEX, fill = col) legendY <- as.character(round(100*Y, digits = 1)) legendY <- paste(Sign[Index], legendY, sep = "") legendY <- paste(legendY, "%") legend("topright", legend = legendY, bty = "n", cex = CEX, fill = col) } # Add Box: if (box) box() # Return Value: invisible(Y) } # ------------------------------------------------------------------------------ tailRiskBudgetsPie <- function(object, pos = NULL, labels = TRUE, col = NULL, box = TRUE, legend = TRUE, radius = 0.8, ...) { ### todo: take care of @portfolio slot ... # A function implemented by Diethelm Wuertz and Oliver Greshake # Arguments: # object - an object of class 'fPORTFOLIO'. # pos - a numeric value, determining the position on the efficient # frontier plotting the pie, by default NULL, i.e. expecting # an object having only one set of weights like the tangency # portfolio. # box - a logical value, determining whether a frame (box) should # be plotted around the pie, by default TRUE. # col - a color palette, by default the rainbow palette. # legend - a logical value, determining whether a legend with # the names of the assets should be plotted, by default TRUE. # Description: # Plots a Pie Chart of Tail Risk Budgets # Arguments: # object - an object of class 'fPORTFOLIO' # col - a color palette, by default the rainbow palette # Example: # riskBudgetsPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec())) # title(main = "Tangency Portfolio Weights") # FUNCTION: # Default Settings: Title <- "Tail Risk Budgets" if (is.null(col)) col <- seqPalette(getNAssets(object), "Blues") if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX <- 0.9 else CEX <- 0.7 # Extracting weights position, if specified if(!is.null(pos)){ object = object object@portfolio$weights = getWeights(object@portfolio)[pos, ] } # Check: stop("Not yet implemented") tailRiskMatrix = getTailRisk(object) X <- getCovRiskBudgets(object) # Check for Negative Pie Segments: nX <- getNAssets(object) Sign <- rep("+", nX) Sign[(1:nX)[X < 0]] <- "-" absX <- abs(X) Index <- (1:nX)[X > 0] # Take care of labels, they are also used by the function pie(): if (!is.logical(labels)) { Names <- pieLabels <- labels labels <- FALSE } else { Names <- pieLabels <- object@data@data$names } # Legend Labels: col <- col[Index] legendAssets <- Names[Index] Labels <- paste(Names, Sign) Labels <- Labels[X > 0] Y <- X[X > 0] # Plot: if (labels) { pie(Y, labels = Labels, col = col, radius = radius, cex = CEX) } else { pie(Y, labels = pieLabels, col = col, radius = radius, ...) } # Add Title: if (labels) mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1) # Add Info: if (labels) { mtext(paste(getType(object), "|", getSolver(object)), side = 4, adj = 0, col = "grey", cex = 0.7) } # Add Legend: if (legend) { legend("topleft", legend = legendAssets, bty = "n", cex = CEX, fill = col) legendY = as.character(round(100*Y, digits = 1)) legendY = paste(Sign[Index], legendY, sep = "") legendY = paste(legendY, "%") legend("topright", legend = legendY, bty = "n", cex = CEX, fill = col) } # Add Box: if (box) box() # Return Value: invisible(Y) } ################################################################################ fPortfolio/R/object-portfolioSpec.R0000644000175100001440000001630112620132672017035 0ustar hornikusers ################################################################################ # FUNCTION: DESCRIPTION: # portfolioSpec Returns an object of class fPFOLIOSPEC # .checkWeights Checks and forces tiny weights to zero # .checkSpecVsConstraints Checks if spec and constraints do match # .checkTargetReturn Checks if target Return is defined ################################################################################ portfolioSpec <- function( model = list( type = "MV", # Alt: "LPM", "CVaR", "LPM" optimize = "minRisk", # Alt: "maxReturn" estimator = "covEstimator", # Alt: "shrinkEstimator", tailRisk = list(), ## I think the LPM a=1 we don't need. ## params = list(alpha = 0.05, a = 1)), ## This is CVaR's alpha it should not be removed here, it is ## ... required in any situation when it comes to the calculation ## ... of VaR and CVaR Risk params = list(alpha = 0.05)), portfolio = list( ## What is the here the meaning of NULL and what makes the ## difference here between NULL and NA? ## ... NULL means, None of the three weights = NULL, targetReturn = NULL, targetRisk = NULL, # Risk Free rate ... riskFreeRate = 0, nFrontierPoints = 50, ## Should not be prined if NA status = NA), optim = list( solver = "solveRquadprog", # Alt: "solveRdonlp2" # "solveRsolnp" # "solveRglpk", # "solveRsymphony" # "solveRsocp" ... objective = c( "portfolioObjective", "portfolioReturn", "portfolioRisk"), ## Should not be printed if type != MV and solver != quadprog options = list(meq = 2), control = list(), trace = FALSE), messages = list( messages = FALSE, note = ""), ampl = list( ampl = FALSE, project = "ampl", solver = "ipopt", protocol = FALSE, trace = FALSE) ) { # A function implemented by Diethelm Wuertz # Description: # Specifies a portfolio to be optimized # Example: # portfolioSpec(portfolio = list(targetReturn = 1.5)) # FUNCTION: # Compose Checklists: # model.type = c("MV", "CVaR") # model.estimator.mean = "mean" # model.estimator.cov = c("cov", "mcd", "Mcd", "shrink") # optim.solver = c("solveRquadprog", "solveRdonlp2", "solveRglpk") # optim.trace = FALSE # Check Arguments: # stopifnot(model$type %in% model.type) # stopifnot(model$estimator[1] %in% model.estimator.mean) # stopifnot(model$estimator[2] %in% model.estimator.cov) # stopifnot(optim$solver %in% optim.solver) # Model Slot: Model = list( type = "MV", optimize = "minRisk", estimator = "covEstimator", tailRisk = NULL, params = list()) model$type = model$type[1] Model[(Names <- names(model))] <- model # Portfolio Slot: Portfolio = list( weights = NULL, targetReturn = NULL, targetRisk = NULL, riskFreeRate = 0, nFrontierPoints = 50, status = 0) Portfolio[(Names <- names(portfolio))] <- portfolio # Check Portfolio - weights, targetReturn, targetRisk: # ... at least two of them must be set to NULL! checkPortfolio = 0 if(!is.null(portfolio$weights)) checkPortfolio = checkPortfolio + 1 if(!is.null(portfolio$targetReturn)) checkPortfolio = checkPortfolio + 1 stopifnot(checkPortfolio <= 1) # Optim Slot: Optim = list( solver = "solveRquadprog", objective = NULL, options = list(meq = 2), control = list(), trace = FALSE) Optim[(Names <- names(optim))] <- optim # Messages Slot: Messages = list( list = NULL) Messages[(Names <- names(messages))] <- messages # Return Value: new("fPFOLIOSPEC", model = Model, portfolio = Portfolio, optim = Optim, messages = messages, ampl = ampl) } # ------------------------------------------------------------------------------ .checkSpec <- function(spec) { # A function implemented by Diethelm Wuertz # Description: # Checks for specification conflicts # FUNCTION: if (getSolver(spec) == "solveRglpk" && getType(spec) == "MV") { # Error Message: cat("\nExecution stopped:") cat("\n Specification conflict for portfolio solver and type.") cat("\nSpec Information:") cat("\n Solver=", getSolver(spec), ",", " type = ", getType(spec), ".", sep = "") cat("\n") stop(call. = FALSE, show.error.messages = "\n returned from Rmetrics") } if (getSolver(spec) == "solveRsymphony" && getType(spec) == "MV") { # Error Message: cat("\nExecution stopped:") cat("\n Specification conflict for portfolio solver and type.") cat("\nSpec Information:") cat("\n Solver=", getSolver(spec), ",", "type = ", getType(spec), ".", sep = "") cat("\n") stop(call. = FALSE, show.error.messages = "\n returned from Rmetrics") } # Return Value: "ok" } # ------------------------------------------------------------------------------ .checkWeights <- function(weights, eps = sqrt(.Machine$double.eps)) { # A function implemented by Diethelm Wuertz # Description: # Sets tiny weights to zero # Arguments: # weights - a numeric vector of portfolio weights # eps - a numeric value, lower bounds of weigths # FUNCTOION: # Check: for(i in 1:length(weights)) { if(abs(weights[i]) < eps) weights[i] = 0 } # Return Value: weights } # ------------------------------------------------------------------------------ .checkSpecVsConstraints <- function(spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Check if spec and constraints do match # Arguments: # spec - portfolio specification as fPFOLIOSPEC object # constraints - as charvec or as fPFOLIOSPEC object # FUNCTOION: # Check: if(class(constraints) == "fPFOLIOCON") constraints = constraints@stringConstraints if(any(constraints == "Short")) { stopifnot(getSolver(spec) == "solveRshortExact") } # Return Value: invisible() } # ------------------------------------------------------------------------------ .checkTargetReturn <- function(spec) { # A function implemented by Diethelm Wuertz # Description: # Check if target Return is defined # Arguments: # spec - specification object # FUNCTOION: # Check: targetReturn = getTargetReturn(spec) if(is.null(targetReturn)) stop("The target return is not available") # Return Value: invisible(targetReturn) } ################################################################################ fPortfolio/R/mathprogQP-ipop.R0000644000175100001440000001513212410301634015762 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # ripopQP Rmetrics Interface for LOQO QP solver # ipopQP Convenience wrapper for LOQO QP solver # ipopQPControl LOQO QP control parameter list # ripop Synonyme name for kernlab::ipop function ############################################################################### ripopQP <- function(objective, lower=0, upper=1, linCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Implements Vandenberg's LOQO Algorithm # Arguments: # objective - list(dvec=NULL, Dmat=NULL) # lower - lower box constraints # upper - upper box constraints # linCons - linear constraints, list with entries: # mat, lower, upper. # control - control list # FUNCTION: # Control List: ctrl <- ipopQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] <- control[name] control <- ctrl BIG <- control$inf # General Settings: dvec <- objective$dvec Dmat <- objective$Dmat Names <- colnames(rbind(dvec, Dmat)) N <- ncol(rbind(dvec, Dmat)) # Box Constraints: if(length(lower) == 1) { par.lower <- rep(lower, N) } else { par.lower <- lower } if(length(upper) == 1) { par.upper <- rep(upper, N) } else { par.upper <- upper } par.lower[is.infinite(par.lower)] <- BIG*sign(par.lower[is.infinite(par.lower)]) par.upper[is.infinite(par.upper)] <- BIG*sign(par.upper[is.infinite(par.upper)]) # Linear Constraints: if(missing(linCons)) { eqA <- ineqA <- NULL eqA.bound < ineqA.lower <- ineqA.upper <- NULL } else { mat <- linCons[[1]] M <- nrow(mat) lower <- linCons[[2]] upper <- linCons[[3]] if(length(lower) == 1) lower <- rep(lower, M) if(length(upper) == 1) upper <- rep(upper, M) lower[is.infinite(lower)] <- BIG*sign(lower[is.infinite(lower)]) upper[is.infinite(upper)] <- BIG*sign(upper[is.infinite(upper)]) eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) if (length(eqIndex) == 0) { eqA <- NULL eqA.bound <- NULL } else { eqA <- mat[eqIndex, ] eqA.bound <- lower[eqIndex] } if (length(ineqIndex) == 0) { ineqA <- NULL ineqA.lower <- NULL ineqA.upper <- NULL } else { ineqA <- mat[ineqIndex, ] ineqA.lower <- lower[ineqIndex] ineqA.upper <- upper[ineqIndex] } } # Optimize Portfolio: optim <- ipopQP( objective, par.lower, par.upper, eqA, eqA.bound, ineqA, ineqA.lower, ineqA.upper, control) # Return Value: value <- list( opt = optim, solution = optim$solution, objective = optim$objective, status = optim$status, message = optim$message, solver = "ipop", version = optim$version) class(value) = c("solver", "list") value } ############################################################################### ipopQP <- function( objective=list(dvec=NULL, Dmat = NULL), par.lower=NULL, par.upper=NULL, eqA=NULL, eqA.bound=NULL, ineqA=NULL, ineqA.lower=NULL, ineqA.upper=NULL, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Implements Vandenberg's LOQO Algorithm # FUNCTION: # Control List: ctrl <- ipopQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] <- control[name] control <- ctrl # General Settings: dvec <- objective$dvec Dmat <- objective$Dmat Names <- colnames(rbind(dvec, Dmat)) N <- ncol(rbind(dvec, Dmat)) # Solve: optim <- ripop( c = objective$dvec, H = objective$Dmat, A = rbind(eqA, ineqA), b = c(eqA.bound, ineqA.lower), l = par.lower, u = par.upper, r = c(eqA.bound, ineqA.upper) - c(eqA.bound, ineqA.lower), sigf = control$sigf, maxiter = control$maxiter, margin = control$margin, bound = control$bound, verb = control$verb) # Add: if (optim@how == "converged") Status <- 0 else Status <- 1 par <- optim@primal names(par) <- Names Message <- optim@how # Version: package <- packageDescription(pkg="kernlab") version <- paste(package$Package, package$Version, package$Date) # Return Value: ans <- list( opt = optim, solution = par, objective = c( dvec %*% par + 0.5 * par %*% Dmat %*% par )[[1]], status = Status, message = Message, solver = "ipop", version = version) class(ans) = c("solver", "list") ans } ############################################################################### ripop <- kernlab::ipop ############################################################################### ipopQPControl <- function( sigf=12, maxiter=400, margin=0.05, bound=10, verb=0, inf=1e12, solver="ipop", trace=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns control parameter list # FUNCTION: # Control Parameter: control <- list( sigf = 12, maxiter = 400, margin = 0.05, bound = 10, verb = 0, inf = inf, solver = solver, trace = trace) # Return Value: control } ############################################################################### fPortfolio/R/portfolio-efficientFrontier.R0000644000175100001440000002675312323217770020440 0ustar hornikusers ################################################################################ # FUNCTION: DESCRIPTION: # portfolioFrontier Returns the efficient frontier of a portfolio # DEPRECATED: # .portfolioFrontier old/alt Version ################################################################################ portfolioFrontier <- function(data, spec = portfolioSpec(), constraints = "LongOnly", include.mvl = TRUE, title = NULL, description = NULL) { # A function implemented by Rmetrics # Description: # Computes the efficient frontier of a portfolio # Arguments: # data - a rectangular object of assets # spec - an object of class 'fPFOLIOSPEC' # constraints - a character vector or NULL # include.mvl - a logical flag, should the minimum variance # locus be added to the plot? # Example: # data = as.timeSeries(data(LPP2005REC))[, 1:6] # spec = portfolioSpec() # constraints = c("minW[3:4]=0.1", "maxW[5:6]=0.8", "minsumW[1:3]=0.2", "maxsumW[c(2,4)]=0.8") # portfolioFrontier(data, spec, constraints) # FUNCTION: DEBUG <- TRUE # Match Spec Versus Constraints? .checkSpecVsConstraints(spec, constraints) # Transform Data and Constraints: Data <- portfolioData(data, spec) # Optimize in N Points the Portfolios along the frontier: nFrontierPoints = getNFrontierPoints(spec) # The Target Return - get problems in the first and last point for # long only portfolios, just move a little bit aside ... mu <- getMu(Data) targetReturns <- seq(min(mu), max(mu), length = nFrontierPoints) eps <- .Machine$double.eps^0.5 targetReturns[1] = targetReturns[1]*(1+eps) targetReturns[nFrontierPoints] = targetReturns[nFrontierPoints]*(1-eps) # How to Go Along the Frontier ? # The Idea is to start from the minvariance portfolio and to explore # the efficient frontier and the minimum variance locus starting from # this point ... # Then we stop when the status flag fails ... # Compute minvariancePortfolio: mvPortfolio <- minvariancePortfolio(Data, spec, constraints) mvReturn <- getTargetReturn(mvPortfolio@portfolio)["mean"] minIndex <- which.min(abs(mvReturn-targetReturns)) # Upper Frontier Part: Status <- 0 IDX <- minIndex weights <- targetReturn <- targetRisk <- covRiskBudgets <- maxDD <- NULL while (Status == 0 & IDX <= nFrontierPoints) { # Add Target Return to Specification: setTargetReturn(spec) = targetReturns[IDX] # Optimize Efficient Portfolio: ans = try(efficientPortfolio(Data, spec, constraints), silent = TRUE) if (class(ans) == "try-error") { Status = 1 } else { portfolio = ans Status = getStatus(portfolio) } if (Status == 0) { Weights = getWeights(portfolio) weights = rbind(weights, Weights) targetReturn = rbind(targetReturn, getTargetReturn(portfolio@portfolio)) targetRisk = rbind(targetRisk, getTargetRisk(portfolio@portfolio)) covRiskBudgets = rbind(covRiskBudgets, getCovRiskBudgets(portfolio@portfolio)) ### maxDD = rbind(maxDD, ### min(drawdowns(pfolioReturn(data/100, as.vector(Weights)))) ) } IDX = IDX + 1 } # Lower Min Variance Locus: if (include.mvl) { if (minIndex > 1) { weights2 = targetReturn2 = targetRisk2 = covRiskBudgets2 = maxDD2 = NULL Status = 0 IDX = minIndex - 1 while (Status == 0 & IDX > 0) { # Add Target Return to Specification: setTargetReturn(spec) = targetReturns[IDX] # Optimize Efficient Portfolio: ans = try(efficientPortfolio(Data, spec, constraints), silent = TRUE) if (class(ans) == "try-error") { Status = 1 } else { portfolio = ans Status = getStatus(portfolio) } if (Status == 0) { Weights2 = getWeights(portfolio) weights2 = rbind(Weights2, weights2) targetReturn2 = rbind(getTargetReturn(portfolio@portfolio), targetReturn2) targetRisk2 = rbind(getTargetRisk(portfolio@portfolio), targetRisk2) covRiskBudgets2 = rbind(getCovRiskBudgets(portfolio@portfolio), covRiskBudgets2) ### maxDD2 = rbind(maxDD2, min(drawdowns( ### pfolioReturn(data/100, as.vector(Weights2)))) ) } IDX = IDX - 1 } weights = rbind(weights2, weights) targetReturn = rbind(targetReturn2, targetReturn) targetRisk = rbind(targetRisk2, targetRisk) covRiskBudgets = rbind(covRiskBudgets2, covRiskBudgets) ### maxDD = rbind(maxDD2, maxDD) } } colnames(weights) <- names(getMu(Data)) rownames(weights) <- NULL rownames(covRiskBudgets) <- NULL rownames(targetReturn) <- NULL rownames(targetRisk) <- NULL # Check: Did we find points on the frontier? if (is.null(weights)) { portfolio <- mvPortfolio ### portfolio@portfolio$maxDD = min(drawdowns( ### pfolioReturn(data/100, as.vector(getWeights(mvPortfolio))))) return(portfolio) } # Reset Target Return: setTargetReturn(spec) <- NULL # Call: portfolio@call <- match.call() # Compose Portfolio: portfolio@portfolio <- new("fPFOLIOVAL", portfolio = list( weights = weights, covRiskBudgets = covRiskBudgets, targetReturn = targetReturn, targetRisk = targetRisk, targetAlpha = getAlpha(spec), minriskPortfolio = mvPortfolio, status = 0)) ### portfolio@portfolio$maxDD = maxDD # Update Title portfolio@title = "Portfolio Frontier" # Return Value: portfolio } ################################################################################ # DEPRECATED .portfolioFrontier <- function(data, spec = portfolioSpec(), constraints = "LongOnly", include.mvl = TRUE, title = NULL, description = NULL) { # A function implemented by Rmetrics # Description: # Computes the efficient frontier of a portfolio # Arguments: # data - a rectangular object of assets # spec - an object of class 'fPFOLIOSPEC' # constraints - a character vector or NULL # Example: # data = as.timeSeries(data(LPP2005REC))[, 1:6] # spec = portfolioSpec() # constraints = c("minW[3:4]=0.1", "maxW[5:6]=0.8", "minsumW[1:3]=0.2", "maxsumW[c(2,4)]=0.8") # portfolioFrontier(data, spec, constraints) # FUNCTION: DEBUG = TRUE # Match Spec Versus Constraints? .checkSpecVsConstraints(spec, constraints) # Transform Data and Constraints: Data = portfolioData(data, spec) data <- getSeries(Data) # Optimize in N Points the Portfolios along the frontier: nFrontierPoints = getNFrontierPoints(spec) # The Target Return - get problems in the first and last point for # long only portfolios, just move a little bit aside ... mu = getMu(Data) targetReturns <- seq(min(mu), max(mu), length = nFrontierPoints) eps = .Machine$double.eps^0.5 targetReturns[1] = targetReturns[1]*(1+eps) targetReturns[nFrontierPoints] = targetReturns[nFrontierPoints]*(1-eps) # How to Go Along the Frontier ? # The Idea is to start from the minvariance portfolio and to explore # the efficient frontier and the minimum variance locus starting from # this point ... # Then we stop when the status flag fails ... # Compute minvariancePortfolio: mvPortfolio = minvariancePortfolio(Data, spec, constraints) mvReturn = getTargetReturn(mvPortfolio)[, "mean"] minIndex = which.min(abs(mvReturn-targetReturns)) # Upper Frontier Part: Status = 0 IDX = minIndex weights = targetReturn = targetRisk = covRiskBudgets = maxDD = NULL while (Status == 0 & IDX <= nFrontierPoints) { # Add Target Return to Specification: setTargetReturn(spec) = targetReturns[IDX] # Optimize Efficient Portfolio: ans = try(efficientPortfolio(Data, spec, constraints), silent = TRUE) if (class(ans) == "try-error") { Status = 1 } else { portfolio = ans Status = getStatus(portfolio) } if (Status == 0) { Weights = getWeights(portfolio) weights = rbind(weights, Weights) targetReturn = rbind(targetReturn, getTargetReturn(portfolio)) targetRisk = rbind(targetRisk, getTargetRisk(portfolio)) covRiskBudgets = rbind(covRiskBudgets, getCovRiskBudgets(portfolio)) maxDD = rbind(maxDD, min(drawdowns(pfolioReturn(data/100, as.vector(Weights)))) ) } IDX = IDX + 1 } # Lower Min Variance Locus: if (include.mvl) { if (minIndex > 1) { weights2 = targetReturn2 = targetRisk2 = covRiskBudgets2 = maxDD2 = NULL Status = 0 IDX = minIndex - 1 while (Status == 0 & IDX > 0) { # Add Target Return to Specification: setTargetReturn(spec) = targetReturns[IDX] # Optimize Efficient Portfolio: ans = try(efficientPortfolio(Data, spec, constraints), silent = TRUE) if (class(ans) == "try-error") { Status = 1 } else { portfolio = ans Status = getStatus(portfolio) } if (Status == 0) { Weights2 = getWeights(portfolio) weights2 = rbind(Weights2, weights2) targetReturn2 = rbind(getTargetReturn(portfolio), targetReturn2) targetRisk2 = rbind(getTargetRisk(portfolio), targetRisk2) covRiskBudgets2 = rbind(getCovRiskBudgets(portfolio), covRiskBudgets2) maxDD2 = rbind(maxDD2, min(drawdowns( pfolioReturn(data/100, as.vector(Weights2)))) ) } IDX = IDX - 1 } weights = rbind(weights2, weights) targetReturn = rbind(targetReturn2, targetReturn) targetRisk = rbind(targetRisk2, targetRisk) covRiskBudgets = rbind(covRiskBudgets2, covRiskBudgets) maxDD = rbind(maxDD2, maxDD) } } # Check: Did we find points on the frontier? if (is.null(weights)) { portfolio = mvPortfolio portfolio@portfolio$maxDD = min(drawdowns( pfolioReturn(data/100, as.vector(getWeights(mvPortfolio))))) return(portfolio) } # Reset Target Return: setTargetReturn(spec) <- NULL # Compose Frontier: portfolio@call = match.call() portfolio@portfolio$weights = weights portfolio@portfolio$targetReturn = targetReturn portfolio@portfolio$targetRisk = targetRisk portfolio@portfolio$covRiskBudgets = covRiskBudgets portfolio@portfolio$maxDD = maxDD portfolio@portfolio$status = 0 portfolio@portfolio$minriskPortfolio = mvPortfolio portfolio@title = "Portfolio Frontier" # Return Value: portfolio } ############################################################################### fPortfolio/R/portfolio-rollingPfolio.R0000644000175100001440000001650312323217770017602 0ustar hornikusers ################################################################################ # FUNCTION: DESCRIPTION: # rollingWindows Returns a list of rolling window frames # FUNCTION: DESCRIPTION: # rollingCmlPortfolio Rolls a CML portfolio # rollingTangencyPortfolio Rolls a tangency portfolio # rollingMinvariancePortfolio Rolls a minimum risk portfolio # FUNCTION: DESCRIPTION: # rollingPortfolioFrontier Rolls a portfolio frontier ################################################################################ rollingWindows <- function(x, period = "12m", by = "1m") { # A function implemented by Diethelm Wuertz and Yohan Chalabi # Description: # Returns vectors of start and end dates for a rolling time series # Arguments: # x - a timeSeries object of asset returns # period - a character string denoting the length of the rolling # window, e.g. "24m" means 24 months # by - a character string denoting the shift of the rolling window, # e.g. "1m" means one month # Note: # Only "monthly" frequencies are currently supported. # Example: # x = sort(as.timeSeries(data(smallcap.ts))); rollingWindows(x) # FUNCTION: # Get Window Parameter: periodLength = as.numeric(substr(period, 1, nchar(period)-1)) periodUnit = substr(period, nchar(period), nchar(period)) byLength = as.numeric(substr(by, 1, nchar(by)-1)) byUnit = substr(by, nchar(by), nchar(by)) stopifnot(periodUnit == "m") stopifnot(byUnit == "m") # Make Windows - expand series x to a monthly series: positions = time(x) startPositions = unique(timeFirstDayInMonth(positions)) # for non monthly data # series(startPositions)[1] <- as.vector(start(x)) endPositions = unique(timeLastDayInMonth(positions)) # for non monthly data # series(endPositions)[length(endPositions)] <- as.vector(end(x)) numberOfPositions = length(startPositions) startSeq <- seq( from = 1, to = (numberOfPositions-periodLength + 1), by = byLength) startDates = startPositions[startSeq] endSeq <- seq(from = periodLength, to = numberOfPositions, by = byLength) endDates = endPositions[endSeq] # Windows: windows = list( from = startDates, to = endDates) attr(windows, "control") = list( start = start(positions), end = end(positions), period = period, by = by) # Return Value: windows } # ------------------------------------------------------------------------------ rollingCmlPortfolio <- function(data, spec, constraints, from, to, action = NULL, title = NULL, description = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Computes EF on a rolling timeSeries Windows # Arguments: # FUNCTION: # Roll the Frontier and return it in a list: roll = list() for (i in 1:length(from)) { # Data must be a multivariate timeSeries object ... series = cut(data, from = from[i], to = to[i]) # Calculation efficient frontiers and save them all in a list: portfolio = tangencyPortfolio(data = series, spec, constraints) roll[[i]] = portfolio # Now you can do any "action" you want to do with the EFs: if (!is.null(action)) { fun = match.fun(action) fun(roll, from, to, ...) } } # Return Value: invisible(roll) } # ------------------------------------------------------------------------------ rollingTangencyPortfolio <- function(data, spec, constraints, from, to, action = NULL, title = NULL, description = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Computes EF on a rolling timeSeries Windows # Arguments: # windows - a list with two named 'timeDate' entries, "from" and # "to", defining the start and end dates of your windows. # ... - optional parameters which can be directed to the optional # function action(). # FUNCTION: # Roll the Frontier and return it in a list: roll = list() for (i in 1:length(from)) { # Data must be a multivariate timeSeries object ... series = cut(data, from = from[i], to = to[i]) # Calculation efficient frontiers and save them all in a list: portfolio = tangencyPortfolio(data = series, spec, constraints) roll[i] = portfolio # Now you can do any "action" you want to do with the EFs: if (!is.null(action)) { fun = match.fun(action) fun(roll, from, to, ...) } } # Return Value: invisible(roll) } # ------------------------------------------------------------------------------ rollingMinvariancePortfolio <- function(data, spec, constraints, from, to, action = NULL, title = NULL, description = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Computes EF on a rolling timeSeries Windows # Arguments: # windows - a list with two named 'timeDate' entries, "from" and # "to", defining the start and end dates of your windows. # ... - optional parameters which can be directed to the optional # function action(). # FUNCTION: # Roll the Frontier and return it in a list: roll = list() for (i in 1:length(from)) { # Data must be a multivariate timeSeries object ... series = cut(data, from = from[i], to = to[i]) # Calculation efficient frontiers and save them all in a list: portfolio = minvariancePortfolio(data = series, spec, constraints) roll[i] = portfolio # Now you can do any "action" you want to do with the EFs: if (!is.null(action)) { fun = match.fun(action) fun(roll, from, to, ...) } } # Return Value: invisible(roll) } ################################################################################ rollingPortfolioFrontier <- function(data, spec, constraints, from, to, action = NULL, title = NULL, description = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Computes EF on a rolling timeSeries Windows # Arguments: # windows - a list with two named 'timeDate' entries, "from" and # "to", defining the start and end dates of your windows. # ... - optional parameters which can be directed to the optional # function action(). # FUNCTION: # Roll the Frontier and return it in a list: roll = list() for (i in 1:length(from)) { # Data must be a multivariate timeSeries object ... series = cut(data, from = from[i], to = to[i]) # Calculation efficient frontiers and save them all in a list: frontier = portfolioFrontier(data = series, spec, constraints, title = title, description = description) roll[i] = frontier # Now you can do any "action" you want to do with the EFs: if (!is.null(action)) { fun = match.fun(action) fun(roll, from, to, ...) } } # Return Value: invisible(roll) } ################################################################################ fPortfolio/R/solve-Ripop.R0000644000175100001440000001073612323217770015171 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRipop Portfolio interface to solver Ripop # .ripopArguments Returns arguments for solver ################################################################################ solveRipop <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Portfolio interface to solver Ripop # Example: # data <- 100 * LPP2005.RET[, 1:6] # spec <- portfolioSpec() # setTargetReturn(spec) <- mean(data) # setSolver(spec) <- "solveRipop" # solveRipop(data, spec) # FUNCTION: # Transform Data: Data <- portfolioData(data, spec) data <- getSeries(Data) nAssets <- getNAssets(Data) # Compile Arguments for Solver: args <- .ripopArguments(data, spec, constraints) # Optimize Portfolio: ans <- try(ipopQP( objective = args$objective, par.lower = args$par.lower, par.upper = args$par.upper, eqA = args$eqA, eqA.bound = args$eqA.bound, ineqA = args$ineqA, ineqA.lower = args$ineqA.lower, ineqA.upper = args$ineqA.upper, control = list()), silent = TRUE) if (inherits(ans, "try-error")) { # When Optimization Failed: ans <- list( opt = list(dvec=NA, Dmat=NULL), objective = 1e99, status = 1, message = "error", weights = rep(0, times=nAssets)) run <- "failed" } else { # Set Tiny Weights to Zero: ans$weights <- .checkWeights(ans$solution) ans$solution <- NULL run <- "passed" } ans$solver <- "solveRipop" ans$solution <- ans$weights attr(ans$weights, "invest") <- sum(ans$weights) attr(ans$opt, "args") <- args # Class: class(ans) <- c("solver", "list") # Return Value: ans } # ----------------------------------------------------------------------------- .ripopArguments <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Returns ipopQP conform arguments for the solver # FUNCTION: # Data and Constraints as S4 Objects: Data <- portfolioData(data) data <- getSeries(Data) nAssets <- getNAssets(Data) Sigma <- getSigma(Data) # Box Constraints: par.lower <- minWConstraints(data, spec, constraints) par.upper <- maxWConstraints(data, spec, constraints) # Set up Equality Constraints: eqsumW <- eqsumWConstraints(data, spec, constraints) eqA <- eqsumW[, -1] eqA.bound <- eqsumW[, 1] # Set up Inequality Constraints: minsumW <- minsumWConstraints(data, spec, constraints) maxsumW <- maxsumWConstraints(data, spec, constraints) ineqA <- NULL if(!is.null(minsumW)) ineqA = rbind(ineqA, minsumW[, -1]) if(!is.null(maxsumW)) ineqA = rbind(ineqA, maxsumW[, -1]) ineqA.lower <- ineqA.upper <- NULL if(!is.null(minsumW)) { ineqA.lower = c(ineqA.lower, +minsumW[, 1]) ineqA.upper = c(ineqA.upper, rep(sum(par.upper), times=length(minsumW[, 1]))) } if(!is.null(maxsumW)) { ineqA.lower = c(ineqA.lower, rep(sum(par.lower), times=length(maxsumW[, 1]))) ineqA.upper = c(ineqA.upper, maxsumW[, 1]) } # Return Value: list( objective = list(dvec = rep(0, nAssets), Dmat = Sigma), par.lower = par.lower, par.upper = par.upper, eqA = eqA, eqA.bound = eqA.bound , ineqA = ineqA, ineqA.lower = ineqA.lower, ineqA.upper = ineqA.upper ) } ################################################################################ fPortfolio/R/backtest-rollingStats.R0000644000175100001440000001661712410031014017217 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 US ################################################################################ # FUNCTION: DESCRIPTION: # backtestStats Wrapper function for calculating rolling statistics # FUNCTION: DESCRIPTION: # rollingSigma Rolling portfolio Sigma risk # rollingVaR Rolling Value at Risk # rollingCVaR Rolling Conditional Value at Risk # rollingDar Rolling Drawdowns at Risk # rollingCDaR Rolling Conditional Drawdowns at Risk ################################################################################ backtestStats <- function(object, FUN = "rollingSigma", ...) { # A function implemented by William Chen # Description: # Wrapper function for calculating rolling statistics # Arguments: # object - a list as returned by the function portfolioBacktesting() # FUN - a character string, the name of the statistics function # Example: # data = returns(align(SPISECTOR)) # formula <- SPI ~ BASI+INDU+CONG+HLTH+CONS+TELE+UTIL+FINA+TECH # backtests <- portfolioBacktesting(formula, data, trace = FALSE) # portfolios <- portfolioSmoothing(backtests, portfolioBacktest()) # FUNCTION: # Perform Statistics: statsFun <- match.fun(FUN) ans <- statsFun(object, ...) # Return Value ans } # ------------------------------------------------------------------------------ rollingSigma <- function(object) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Returns rolling sigmas from an object of class fPFOLIOBACKTEST # Arguments: # object - a list as returned by the function portfolioBacktesting() # Example: # rollingSigma(object) # FUNCTION: # quick fix ... there is some confusion with getTargetRisk of # @portfolio and @spec portfolios <- object$strategyList prtval <- lapply(portfolios, slot, "portfolio") ans <- sapply(prtval, function(x) getTargetRisk(x)["Sigma"]) dates <- sapply(portfolios, function(x) rev(rownames(getSeries(x)))[1]) # Return Value: timeSeries(ans, charvec = dates, units = "Sigma") } # ------------------------------------------------------------------------------ rollingVaR <- function(object) { # A function implemented by William Chen # Description: # Returns rolling VaR from an object of class fPFOLIOBACKTEST # Arguments: # object - a list as returned by the function portfolioBacktesting() # Example: # rollingVaR(object) # FUNCTION: # calculate VaR for one portfolio: .var <- function(x) { alpha <- getAlpha(x) R <- as.numeric(getSeries(x) %*% getWeights(x)) quantile(R, probs = alpha) } # Get Portfolios: portfolios <- object$strategyList # Calculates VaR for all portfolios: ans <- sapply(portfolios, FUN = .var) # Extracts the dates: dates <- sapply(portfolios, function(x) rev(rownames(getSeries(x)))[1]) # Return Value: alpha <- getAlpha(portfolios[[1]]) timeSeries(ans, charvec = dates, units = paste("VaR", alpha, sep = ".")) } # ------------------------------------------------------------------------------ rollingCVaR <- function(object) { # A function implemented by William Chen # Description: # Returns rolling DVaR from an object of class fPFOLIOBACKTEST # Arguments: # object - a list as returned by the function portfolioBacktesting() # Example: # rollingCVaR(object) # FUNCTION: # Calculate CVaR for one portfolio: .cvar <- function(x) { alpha <- getAlpha(x) R <- as.numeric(getSeries(x) %*% getWeights(x)) z <- quantile(R, probs = alpha) mean(R[R <= z], na.rm = TRUE) } # Get Portfolios: portfolios <- object$strategyList # Calculate CVaR for all portfolios: ans <- sapply(portfolios, FUN = .cvar) # Extract the Dates: dates <- sapply(portfolios, function(x) rev(rownames(getSeries(x)))[1]) # Return: alpha <- getAlpha(portfolios[[1]]) timeSeries(ans, charvec = dates, units = paste("CVaR", alpha, sep = ".")) } # ------------------------------------------------------------------------------ rollingDaR <- function(object) { # A function implemented by William Chen # Description: # Returns rolling DaR from an object of class fPFOLIOBACKTEST # Arguments: # object - a list as returned by the function portfolioBacktesting() # Example: # rollingDaR(object) # FUNCTION: # calculate DaR for one portfolio: .dar <- function(x) { alpha <- getAlpha(x) R <- as.numeric(getSeries(x) %*% getWeights(x)) dd <- 100 * drawdowns(as.timeSeries(R)/100) quantile(dd, probs = alpha) } # Get Portfolios: portfolios <- object$strategyList # Calculates DaR for all portfolios: ans <- sapply(portfolios, FUN = .dar) # Extracts the dates: dates <- sapply(portfolios, function(x) rev(rownames(getSeries(x)))[1]) # Return: alpha <- getAlpha(portfolios[[1]]) timeSeries(ans, charvec = dates, units = paste("DaR", alpha, sep = ".")) } # ------------------------------------------------------------------------------ rollingCDaR <- function(object) { # A function implemented by William Chen # Description: # Returns rolling CDaR from an object of class fPFOLIOBACKTEST # Arguments: # object - a list as returned by the function portfolioBacktesting() # Example: # rollingCDaR(object) # FUNCTION: # Calculate CDaR for one portfolio: .cdar <- function(x){ alpha <- getAlpha(x) R <- as.numeric(getSeries(x) %*% getWeights(x)) dd <- 100 * drawdowns(as.timeSeries(R)/100) z <- quantile(as.numeric(dd), probs = alpha) mean(dd[dd <= z]) } # Get Portfolios: portfolios <- object$strategyList # Calculate CVaR for all portfolios: ans <- sapply(portfolios, FUN = .cdar) # Extract the dates: dates <- sapply(portfolios, function(x) rev(rownames(getSeries(x)))[1]) # Return: alpha <- getAlpha(portfolios[[1]]) timeSeries(ans, charvec = dates, units = paste("CDaR", alpha, sep = ".")) } ################################################################################ fPortfolio/R/object-portfolioConstraints.R0000644000175100001440000005663712323217770020475 0ustar hornikusers ################################################################################ # FUNCTION: DESCRIPTION: # portfolioConstraints Returns an object of class fPFOLIOCON # FUNCTION: DESCRIPTION: # minWConstraints Returns vector with min box constraints # maxWConstraints Returns vector with max box constraints # eqsumWConstraints Returns list with group equal vec/matrix constraints # minsumWConstraints Returns list with group min vec/matrix constraints # maxsumWConstraints Returns list with group max vec/matrix constraints # minBConstraints Returns vector with min cov risk budget constraints # maxBConstraints Returns vector with max cov risk budget constraints # minFConstraints Returns vector with min nonlin functions constraints # maxFConstraints Returns vector with max nonlin functions constraints # minBuyinConstraints Returns lower bound of buyin constraints # maxBuyinConstraints Returns upper bound of buyin constraints # nCardConstraints Returns number of Cardinalities # minCardConstraints Returns lower bound of Cardinalities # maxCardConstraints Returns upper bound of Cardinalities ################################################################################ portfolioConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly", ...) { # A function implemented by Diethelm Wuertz # Description: # Returns an object of class fPFOLIOCON # Arguments: # data - a timeSeries or a fPFOLIODATA object # spec - a fPFOLIOSPEC object # constraints - a constraints string # validStrings = c( # "LongOnly", "Short", # LongOnly and Short Notification # "minW", "maxW", # Box Constraints # "minsumW", "maxsumW", # left/right Sided Group Constraints # "minB", "maxB", # Covariance Risk Budgets # "listF", "minF", "maxF", # Nonlinear Functions Constraints # NEW: "minBuyin"," maxBuyin", # NEW: "nCard", "minCard", "maxCard") # Details: # This function takes the constraints strings and converts them to # constraints vectors and matrices of the following form: # 1. boxConstraints W_min <= W <= W_max # 2. groupEqConstraints A_eq W = c_eq # 3. groupMatConstraints a_vec <= A_mat W <= b_vec # 4. riskBudgetConstraints a <= RiskBudget <= b # cardinalityConstraints eps*z <= W <- delta*z, z[0,1], Sum(z)=K # These values are returned as list in four slots. # Example: # data = .lppData; spec=.mvSpec # portfolioConstraints(data, spec, "LongOnly") # constraints=c("minW[1:3]=0.1", "maxW[4:6]=0.9", "minsumW[c(2,5)]=0.2", "maxsumW[c(1,4)]=0.9") # portfolioConstraints(data, spec, constraints) # FUNCTION: # Already done ... if (class(constraints) == "fPFOLIOCON") return(constraints) # Missing target Return ... if (is.null(getTargetReturn(spec))) setTargetReturn(spec) <- NA # Handle NULL - A NULL : if (is.null(constraints)) constraints="LongOnly" # Check Vector of Valid Strings - these are strings ... validStrings = c( "LongOnly", "Short", # LongOnly and Short Notification "minW", "maxW", # Box Constraints "minsumW", "maxsumW", # left and right Sided Group Constraints "minB", "maxB", # Covariance Risk Budgets "listF", "minF", "maxF", # Nonlinear Functions Constraints "nCard", "minCard", "maxCard") if (any(constraints == "Short")) setSolver(spec) = "solveRshortExact" # usedStrings <- unique(sort(sub("\\[.*", "", constraints))) # checkStrings <- usedStrings %in% validStrings # check <- (sum(!checkStrings) == 0) # if (check) check <- "valid" else stop("Invalid Constraints String(s)") stringConstraints <- constraints # attr(stringConstraints, "control") = check # Data: Data <- portfolioData(data, spec) # Constraints: minW <- minWConstraints(Data, spec, constraints) maxW <- maxWConstraints(Data, spec, constraints) eqsumW <- eqsumWConstraints(Data, spec, constraints) minsumW <- minsumWConstraints(Data, spec, constraints) maxsumW <- maxsumWConstraints(Data, spec, constraints) minB <- minBConstraints(Data, spec, constraints) maxB <- maxBConstraints(Data, spec, constraints) listF <- listFConstraints(Data, spec, constraints) minF <- minFConstraints(Data, spec, constraints) maxF <- maxFConstraints(Data, spec, constraints) minBuyin <- minCardConstraints(Data, spec, constraints) maxBuyin <- maxCardConstraints(Data, spec, constraints) nCard <- nCardConstraints(Data, spec, constraints) minCard <- minCardConstraints(Data, spec, constraints) maxCard <- maxCardConstraints(Data, spec, constraints) if(is.null(minW)) minW = numeric() if(is.null(maxW)) maxW = numeric() if(is.null(eqsumW)) eqsumW = matrix(NA) if(is.null(minsumW)) minsumW = matrix(NA) if(is.null(maxsumW)) maxsumW = matrix(NA) if(is.null(minB)) minB = numeric() if(is.null(maxB)) maxB = numeric() if(is.null(maxsumW)) maxsumW = matrix(NA) if(is.null(minF)) minF = numeric() if(is.null(maxF)) maxF = numeric() if(is.null(minBuyin)) minBuyin = numeric() if(is.null(maxBuyin)) maxBuyin = numeric() if(is.null(nCard)) nCard = integer() if(is.null(minCard)) minCard = numeric() if(is.null(maxCard)) maxCard = numeric() # Return Value: new("fPFOLIOCON", stringConstraints=stringConstraints, minWConstraints=minW, maxWConstraints=maxW, eqsumWConstraints=eqsumW, minsumWConstraints=minsumW, maxsumWConstraints=maxsumW, minBConstraints=minB, maxBConstraints=maxB, listFConstraints=listF, minFConstraints=minF, maxFConstraints=maxF, minBuyinConstraints=minBuyin, maxBuyinConstraints=maxBuyin, nCardConstraints=nCard, minCardConstraints=minCard, maxCardConstraints=maxCard ) } ################################################################################ minWConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Returns a vector with min box constraints # Details: # Takes care of "minW" strings, i.e. lower blounds # W >= c # Arguments: # data - a timeSeries or a fPFOLIODATA object # spec - a fPFOLIOSPEC object # constraints - a constraints string # Example: # data <- as.timeSeries(data(LPP2005REC))[, 1:6] # spec <- portfolioSpec() # constraints <- c("minW[3:4]=0.1", "maxW[5:6]=0.8") # minWConstraints(data, spec, constraints) # FUNCTION: # Settings: Data <- portfolioData(data, spec) if (class(data) == "fPFOLIODATA") data <- getSeries(Data) nAssets <- getNAssets(Data) assetsNames <- getUnits(Data) # Consider LongOnly: if("LongOnly" %in% constraints) { minW <- rep(0, nAssets) names(minW) <- assetsNames return(minW) } # Consider Unlimited Short: if("Short" %in% constraints) { minW <- rep(-Inf, nAssets) names(minW) <- assetsNames return(minW) } # Extract and Compose Vectors a_vec and b_vec: minW = rep(0, nAssets) names(minW) = assetsNames if (!is.null(constraints)) { nC <- length(constraints) what <- substr(constraints, 1, 4) for (i in 1:nC) { if (what[i] == "minW") eval(parse(text = constraints[i])) } } names(minW) <- assetsNames return(minW) # Return Value: invisible() } # ------------------------------------------------------------------------------ maxWConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Returns a vector with max box constraints # Details: # Takes care of "maxW" strings, i.e. upper bounds # W >= c # Arguments: # data - a timeSeries or a fPFOLIODATA object # spec - a fPFOLIOSPEC object # constraints - a constraints string # Example: # data = as.timeSeries(data(LPP2005REC))[, 1:6] # spec=portfolioSpec() # constraints=c("minW[3:4]=0.1", "maxW[5:6]=0.8") # maxWConstraints(data, spec, constraints) # FUNCTION: # Settings: Data <- portfolioData(data, spec) if (class(data) == "fPFOLIODATA") data <- getSeries(Data) nAssets <- getNAssets(Data) assetsNames <- getUnits(Data) # Consider LongOnly: if("LongOnly" %in% constraints) { maxW <- rep(1, nAssets) names(maxW) <- assetsNames return(maxW) } # Consider Unlimited Short: if("Short" %in% constraints) { maxW <- rep(Inf, nAssets) names(maxW) = assetsNames return(maxW) } # Extract and Compose Vectors a_vec and b_vec: maxW = rep(1, nAssets) names(maxW) <- assetsNames if (!is.null(constraints)) { nC <- length(constraints) what <- substr(constraints, 1, 4) for (i in 1:nC) { if (what[i] == "maxW") eval(parse(text = constraints[i])) } } names(maxW) = assetsNames return(maxW) # Return Value: invisible() } ################################################################################ eqsumWConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Returns a list with group equal matrix and vectors constraints # Details: # Takes care of "eqsumW" strings # A_eq W = c_eq # Arguments: # data - a timeSeries or a fPFOLIODATA object # spec - a fPFOLIOSPEC object # constraints - a constraints string # Example: # data = as.timeSeries(data(LPP2005REC))[, 1:6] # spec=portfolioSpec(); setTargetReturn(spec) = mean(data) # constraints="eqsumW[1:6]=1" # eqsumWConstraints(data, spec, constraints) # eqsumWConstraints(data, spec, constraints="LongOnly") # eqsumWConstraints(data, spec, constraints=c("LongOnly","Partial")) # FUNCTION: # Get Statistics: Data <- portfolioData(data, spec) if (class(data) == "fPFOLIODATA") data <- getSeries(Data) targetReturn <- getTargetReturn(spec)[1] if (is.null(targetReturn)) { targetReturn = NA # stop("Target Return is Missing") } # Get Data: mu <- getMu(Data) nAssets <- getNAssets(Data) assetsNames <- getUnits(Data) # Target Return: Aeq <- matrix(mu, byrow = TRUE, ncol = nAssets) # Full or partial Investment? if ("partial" %in% tolower(constraints)) fullInvest = FALSE else fullInvest = TRUE # Full Investment: # - negative to handle better partial Investment in Rquadprog: if (fullInvest) Aeq <- rbind(Aeq, -rep(1, nAssets)) # Dimension Names: colnames(Aeq) <- assetsNames if (fullInvest) { rownames(Aeq) <- c("Return", "Budget") } else { rownames(Aeq) <- "Return" } # RHS Vector: if (fullInvest) { ceq <- c(Return = targetReturn, Budget = -1) } else { ceq <- c(Return = targetReturn) } # Extract and Compose Matrix and Vector: what6 = substr(constraints, 1, 6) if (!is.null(constraints)) { nC = length(constraints) for (i in 1:nC) { if (what6[i] == "eqsumW") { eqsumW = rep(0, times = nAssets) names(eqsumW) <- assetsNames eval(parse(text = constraints[i])) Aeq = rbind(Aeq, eqsumW = sign(eqsumW)) a = strsplit(constraints[i], "=")[[1]][2] ceq = c(ceq, eqsumW = as.numeric(a)) } } } eqsumW <- cbind(ceq, Aeq) # If target Return is missing: eqsumW <- na.omit(eqsumW) # Return Value: eqsumW } # ------------------------------------------------------------------------------ minsumWConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Returns a list with group matrix and vectors constraints # Arguments: # data - a timeSeries or a fPFOLIODATA object # spec - a fPFOLIOSPEC object # constraints - a constraints string$ # Details: # Takes care of "minsumW" strings # a_vec <= A_mat W # Example: # data = as.timeSeries(data(LPP2005REC))[, 1:6] # spec=portfolioSpec(); setTargetReturn(spec) = mean(data) # constraints=c("minsumW[2:3]=0.2", "minsumW[c(1,4:6)]=0.2") # minsumWConstraints(data, spec, constraints) # minsumWConstraints(data, spec) # FUNCTION: # Get Statistics: data <- portfolioData(data, spec) # Get Specifications: mu <- getMu(data) nAssets <- getNAssets(data) assetsNames <- getUnits(data) # Extrac and Compose Matrix and Vectors: what7 <- substr(constraints, 1, 7) if (!is.null(constraints)) { nC <- length(constraints) count <- 0 Amat <- NULL avec <- NULL # Partial Investment: if ("partial" %in% tolower(constraints)) { Amat <- rbind(Amat, rep(1, times = nAssets)) avec <- c(avec, 0) } for (i in 1:nC) { if (what7[i] == "minsumW") { count = count + 1 minsumW = rep(0, times = nAssets) names(minsumW) <- assetsNames eval(parse(text = constraints[i])) Amat = rbind(Amat, minsumW = sign(minsumW)) a = strsplit(constraints[i], "=")[[1]][2] avec = c(avec, as.numeric(a)) } } if (!is.null(Amat)){ colnames(Amat) = assetsNames names(avec) = rep("lower", count) } } # Return Value: cbind(avec = avec, Amat = Amat) } # ------------------------------------------------------------------------------ maxsumWConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Returns a list with group matrix and vectors constraints # Arguments: # data - a timeSeries or a fPFOLIODATA object # spec - a fPFOLIOSPEC object # constraints - a constraints string$ # Details: # Takes care of "minsumW" and "maxsumW" strings # a_vec <= A_mat W <= b_vec # Example: # data = as.timeSeries(data(LPP2005REC))[, 1:6] # spec=portfolioSpec(); setTargetReturn(spec) = mean(data) # constraints=c("maxsumW[2:3]=0.7", "maxsumW[c(1,4:6)]=0.8") # maxsumWConstraints(data, spec, constraints) # maxsumWConstraints(data, spec) # FUNCTION: # Get Statistics: data <- portfolioData(data, spec) # Get Specifications: mu <- getMu(data) nAssets <- getNAssets(data) assetsNames <- getUnits(data) # Extract and Compose Matrix and Vectors: what7 = substr(constraints, 1, 7) if (!is.null(constraints)) { nC <- length(constraints) count <- 0 Amat <- NULL avec <- NULL # Partial Investment: if ("partial" %in% tolower(constraints)) { Amat <- rbind(Amat, rep(1, times = nAssets)) avec <- c(avec, 1) } for (i in 1:nC) { if (what7[i] == "maxsumW") { count = count + 1 maxsumW = rep(0, times = nAssets) names(maxsumW) <- assetsNames eval(parse(text = constraints[i])) Amat = rbind(Amat, maxsumW = sign(maxsumW)) a = strsplit(constraints[i], "=")[[1]][2] avec = c(avec, as.numeric(a)) } } if (!is.null(Amat)) { colnames(Amat) = assetsNames names(avec) = rep("upper", count) } } # Return Value: cbind(avec = avec, Amat = Amat) } ################################################################################ minBConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Returns a list with min risk budget constraints vectors # Arguments: # constraints - a constraints string # Example: # data = as.timeSeries(data(LPP2005REC))[, 1:6] # spec=portfolioSpec() # constraints=c("minB[3:4]=0.1","maxB[1:3]=0.3","maxB[c(4,6)]=0.4") # minBConstraints(data, spec, constraints) # minBConstraints(data, spec) # FUNCTION: # Create Data Object: Data <- portfolioData(data, spec) if (class(data) == "fPFOLIODATA") data <- getSeries(Data) # Get Specifications: nAssets <- getNAssets(Data) assetsNames <- getUnits(Data) # Extract and Compose Risk Budgets: minB = rep(-Inf, nAssets) names(minB) <- assetsNames if (!is.null(constraints)) { nC = length(constraints) what = substr(constraints, 1, 4) for (i in 1:nC) { if (what[i] == "minB") eval(parse(text = constraints[i])) } } # Return Value: minB } # ------------------------------------------------------------------------------ maxBConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Returns a list with max risk budget constraints vectors # Arguments: # constraints - a constraints string # Example: # data = as.timeSeries(data(LPP2005REC))[,1:6] # spec=portfolioSpec() # constraints=c("minB[3:4]=0.1","maxB[1:3]=0.3","maxB[c(4,6)]=0.4") # maxBConstraints(data, spec, constraints) # maxBConstraints(data, spec) # FUNCTION: # Create Data Object: Data <- portfolioData(data, spec) if (class(data) == "fPFOLIODATA") data <- getSeries(Data) # Get Specifications: N <- nAssets <- getNAssets(Data) assetsNames <- getUnits(Data) # Extract and Compose Risk Budgets: maxB <- rep(1, N) names(maxB) <- assetsNames if (!is.null(constraints)) { nC = length(constraints) what = substr(constraints, 1, 4) for (i in 1:nC) { if (what[i] == "maxB") eval(parse(text = constraints[i])) } } # Return Value: maxB } ################################################################################ listFConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Nonlinear Constraints # Example: # maxdd <- function(x) max(drawdowns(x)) # listFConstraints(data <- NULL, constraints=c("minF=-0.04", "listF(maxdd)")) # FUNCTION: # Parse: nlin <- list() matched <- pmatch("listF" , constraints) if(!is.na(matched)) { constraints = paste("nlin = ", constraints[matched]) constraints = sub("listF", "list", constraints) eval(parse(text = constraints)) } # Return Value: return(nlin) } # ------------------------------------------------------------------------------ minFConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Nonlinear Constraints # Example: # minFConstraints("minF=-0.04") # FUNCTION: # Parse: minF <- NULL matched <- pmatch("minF" , constraints) if(!is.na(matched)) eval(parse(text = constraints[matched])) # Return Value: return(minF) } # ------------------------------------------------------------------------------ maxFConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Nonlinear Constraints # Example: # maxFConstraints(c("LongOnly", "maxF=0")) # FUNCTION: # Parse: maxF <- NULL matched <- pmatch("maxF" , constraints) if(!is.na(matched)) eval(parse(text = constraints[matched])) # Return Value: return(maxF) } ################################################################################ minBuyinConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Lower Buyin Constraints # Example: minBuyinConstraints(c("LongOnly", "minBuyin[1:3]=0.1") # FUNCTION: # Parse: Data <- portfolioData(data) nAssets <- getNAssets(Data) minBuyin <- rep(0, nAssets) matched <- pmatch("minBuyin", constraints) if(!is.na(matched)) eval(parse(text = constraints[matched])) names(minBuyin) <- getUnits(Data) # Return Value: return(minBuyin) } # ------------------------------------------------------------------------------ maxBuyinConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Upper Buyininality Constraints # Example: maxBuyinConstraints(c("LongOnly", "maxBuyin[5]=0.9") # FUNCTION: # Parse: Data <- portfolioData(data) nAssets <- getNAssets(Data) maxBuyin <- rep(1, nAssets) matched <- pmatch("maxBuyin", constraints) if(!is.na(matched)) eval(parse(text = constraints[matched])) names(maxBuyin) <- getUnits(Data) # Return Value: return(maxBuyin) } ################################################################################ nCardConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Cardinality Constraints # Example: ncardConstraints(c("LongOnly", "ncard=4") # FUNCTION: # Parse: Data <- portfolioData(data) nAssets <- getNAssets(Data) nCard <- nAssets matched <- pmatch("nCard", constraints) if(!is.na(matched)) eval(parse(text = constraints[matched])) # Return Value: return(nCard) } # ------------------------------------------------------------------------------ minCardConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Lower Cardinality Constraints # Example: minCardConstraints(c("LongOnly", "minCard[1:3]=0.1") # FUNCTION: # Parse: Data <- portfolioData(data) nAssets <- getNAssets(Data) minCard <- rep(0, nAssets) matched <- pmatch("minCard", constraints) if(!is.na(matched)) eval(parse(text = constraints[matched])) names(minCard) <- getUnits(Data) # Return Value: return(minCard) } # ------------------------------------------------------------------------------ maxCardConstraints <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Upper Cardinality Constraints # Example: maxCardConstraints(c("LongOnly", "maxCard[5]=0.9") # FUNCTION: # Parse: Data <- portfolioData(data) nAssets <- getNAssets(Data) maxCard <- rep(1, nAssets) matched <- pmatch("maxCard", constraints) if(!is.na(matched)) eval(parse(text = constraints[matched])) names(maxCard) <- getUnits(Data) # Return Value: return(maxCard) } ################################################################################ fPortfolio/R/mathprogQP-kestrel.R0000644000175100001440000001455212323217770016503 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # rkestrelQP Rmetrics Interface for AMPL/KESTREL QP solvers # kestrelQP Convenience wrapper for AMPL/KESTREL QP solvers # kestrelQPControl Control parameter list ############################################################################### rkestrelQP <- function(objective, lower=0, upper=1, linCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Rmetrics Interface for AMPL QP solvers # Arguments: # objective - list(dvec=NULL, Dmat = NULL) # FUNCTION: # Control List: ctrl <- kestrelQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Controls: project <- control$project solver <- control$solver inf <- control$inf trace <- control$trace # General Settings: dvec <- objective$dvec Dmat <- objective$Dmat obj <- rbind(dvec, Dmat) # Box Constraints: replicate <- function(x, n) if(length(x) == 1) rep(x, n) else x n <- ncol(obj) x_L <- replicate(lower, n) x_U <- replicate(upper, n) x_L[is.infinite(x_L)] <- inf*sign(x_L[is.infinite(x_L)]) x_U[is.infinite(x_U)] <- inf*sign(x_U[is.infinite(x_U)]) # Linear Constraints: A <- linCons[[1]] m <- nrow(A) b_L <- replicate(linCons[[2]], m) b_U <- replicate(linCons[[3]], m) b_L[is.infinite(b_L)] <- inf*sign(b_L[is.infinite(b_L)]) b_U[is.infinite(b_U)] <- inf*sign(b_U[is.infinite(b_U)]) # Optimize Portfolio: value <- kestrelQP(objective, x_L, x_U, A, b_L, b_U, control) # Return Value: value } ############################################################################### kestrelQP <- function( objective=list(dvec=NULL, Dmat=NULL), x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list(), ...) { # A function implemented by Diethelm Wuertz # Description: # Convenience wrapper for AMPL QP solvers # Arguments: # objective - list(dvec=NULL, Dmat = NULL) # FUNCTION: # Control List: ctrl <- kestrelQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Control Parameters: project <- control$project solver <- control$solver inf <- control$inf trace <- control$trace # Solver Settings: c <- objective$dvec F <- objective$Dmat obj <- rbind(c, F) n <- ncol(obj) m <- nrow(A) # Assign QP Model: .qpAssign(project, c, F, x_L, x_U, A, b_L, b_U, trace=FALSE) # Write AMPL RUN File: amplRunOpen(project) run <- c( paste("reset ;"), paste("option solver kestrel;"), paste("option kestrel_options 'solver=", solver, "' ;", sep=""), paste("model ", project, ".mod ;", sep = ""), paste("data ", project, ".dat ;", sep = ""), paste("solve ;"), paste("display x > ", project, ".txt ;", sep = ""), paste("display solve_result_num > ", project, ".txt ;", sep = ""), paste("display solve_result > ", project, ".txt ;", sep = ""), paste("display solve_message > ", project, ".txt ;", sep = ""), paste("exit ;") ) amplRunAdd(run, project) if (trace) amplRunShow(project) # Run AMPL: command <- paste("ampl -t -vs", paste(project, "run", sep=".")) solve <- system(command, intern=TRUE) # Read AMPL Output File: file <- paste(project, "txt", sep = ".") out <- scan(file, what = character(0), sep="\n", quiet=TRUE) # Get Weights: Index <- (grep(";", out) - 1)[1] splits <- strsplit(paste(out[2:Index], collapse=" "), " ")[[1]] solution <- as.numeric(splits[splits != ""])[seq(2, 2*n, by=2)] Index <- as.numeric(splits[splits != ""])[seq(1, 2*n, by=2)] solution[Index] <- solution # Get Status: status <- strsplit(out[grep("solve_result", out)], split=" ") statusCode <- status[[1]][3] statusMessage <- status[[2]][3] # Get Solver Message: Index <- grep("solve_message", out):length(out) message <- out[Index] # Version: version <- system(paste(solver, "-v"), intern=TRUE) # Compose Results into a List: objective <- (c %*% solution + 0.5 * solution %*% F %*% solution)[[1, 1]] # Return Value: model <- capture.output(amplModelShow(project)) run <- capture.output(amplRunShow(project)) value = list( opt = list(solve=solve, model=model, run=run, out=out), solution = solution, objective = objective, status = statusCode, message = statusMessage, solver = paste("AMPL", solver), version = version) class(value) <- c("solver", "list") value } # ----------------------------------------------------------------------------- kestrelQPControl <- function(solver="loqo", project="kestrel", inf=1e12, trace=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns AMPL/KESTREL QP control parameter list # FUNCTION: # Control Parameter: control <- list( solver=solver, project=project, inf=inf, trace=trace) # Return Value: control } ############################################################################### fPortfolio/R/utils-amplExtractors.R0000644000175100001440000001160012323217770017107 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # .amplObjval Extracts objective function value # .amplSolution Extracts solution vector # .amplModel Extracts model file information # .amplRun Extracts model file information # .amplSolver Extracts solver name # .amplVersion Extracts version number # .amplPresolve Extracts presolve information ############################################################################### .amplObjval <- function(ampl) { # A function Implemented by Diethelm Wuertz # Description: # Extracts objective function value. # Arguments: # ampl - an object as returned by the the rampl[OPT] solver # functions. # FUNCTION: # Return Value: ampl$objective } # ----------------------------------------------------------------------------- .amplSolution <- function(ampl) { # A function Implemented by Diethelm Wuertz # Description: # Extracts solution vector. # Arguments: # ampl - an object as returned by the the rampl[OPT] solver # functions. # FUNCTION: # Return Value: ampl$solution } # ----------------------------------------------------------------------------- .amplModel <- function(ampl) { # A function Implemented by Diethelm Wuertz # Description: # Extracts model file information # Arguments: # ampl - an object as returned by the the rampl[OPT] solver # functions. # FUNCTION: model <- ampl$opt$model cat(model, sep="\n") # Return Value: invisible(model) } # ----------------------------------------------------------------------------- .amplRun <- function(ampl) { # A function Implemented by Diethelm Wuertz # Description: # Extracts run file information. # Arguments: # ampl - an object as returned by the the rampl[OPT] solver # functions. # FUNCTION: # Get run file: run <- ampl$opt$run cat(, sep="\n") # Return Value: invisible(run) } # ----------------------------------------------------------------------------- .amplSolver <- function(ampl) { # A function Implemented by Diethelm Wuertz # Description: # Extracts solver information # Arguments: # ampl - an object as returned by the the rampl[OPT] solver # functions. # FUNCTION: # Get solver vector: solver <- ampl$solver cat(solver, sep="\n") # Return Value: invisible(solver) } # ----------------------------------------------------------------------------- .amplVersion <- function(ampl) { # A function Implemented by Diethelm Wuertz # Description: # Extracts solver version. # Arguments: # ampl - an object as returned by the the rampl[OPT] solver # functions. # FUNCTION: # Get Version Number: version <- ampl$version cat(version, sep="\n") # Return Value: invisible(version) } # ----------------------------------------------------------------------------- .amplPresolve <- function(ampl) { # A function Implemented by Diethelm Wuertz # Description: # Extracts presolver results # Arguments: # ampl - an object as returned by the the rampl[OPT] solver # functions. # FUNCTION: # Get presolve information: solve <- ampl$opt$solve Index <- grep("^Presolve", solve) solve <- solve[-(1:(Index-1))] Index <- grep("^$", solve)[1] solve <- solve[1:(Index-1)] cat(solve, sep="\n") # Return Value: invisible(solve) } ############################################################################### fPortfolio/R/solve-RglpkMAD.R0000644000175100001440000001634012323217770015476 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRglpk.MAD Portfolio interface to solver Rglpk # .madRglpkArguments Returns MAD arguments for solver # FUNCTION: DESCRIPTION: # .rglpk.MAD Wrapper to solver function ################################################################################ solveRglpk.MAD <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Portfolio interface to solver Rglpk # FUNCTION: # Settings: Data <- portfolioData(data, spec) data <- getSeries(Data) nAssets <- getNAssets(Data) type <- getType(spec) # Compile Arguments for Solver: args <- .madRglpkArguments(Data, spec, constraints) # Solve Multiassets Portfolio: ans <- .rglpk.MAD( obj = args$obj, mat = args$mat, dir = args$dir, rhs = args$rhs, types = args$types, max = args$max, bounds = args$bounds, verbose = args$verbose, nScenarios = args$nScenarios, nAssets = args$nAssets, targetReturn = args$targetReturn, Alpha = args$Alpha, Type = args$Type) ans$solver <- "solveRglpk.MAD" # Return Value: class(ans) = c("solver", "list") ans } ################################################################################ .madRglpkArguments <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Returns glpk conform MAD arguments for the solver # Details: # max/min: obj %*% x # subject to: # mat %*% x ?= rhs # dir = "?=" # upper/lower bounds # # Rglpk_solve_LP(obj, mat, dir, rhs, types = NULL, max = FALSE, # bounds = NULL, verbose = FALSE) # FUNCTION: # Settings: Data <- portfolioData(data, spec) data <- getSeries(Data) nAssets <- ncol(data) nScenarios <- nrow(data) series <- getDataPart(data) series <- series - matrix(rep(colMeans(series), times=nScenarios), byrow=TRUE, ncol=nAssets) targetReturn <- getTargetReturn(spec) Type <- getType(spec) # Objective Function to be Maximized: objNames <- c(paste("e", 1:nScenarios, sep = ""), colnames(data)) obj <- c(rep(1/nScenarios, nScenarios), rep(0, nAssets)) names(obj) <- objNames # 1: # The negative MAD Equation Constraints: # (-diag + [Returns-mu]) %*% (es, W) <= 0 Aneg <- cbind(-diag(nScenarios), series) aneg <- rep(0, nrow(Aneg)) dneg <- rep("<=", nrow(Aneg)) # 2: # The positive MAD Equation Constraints: # (+diag + [Returns-mu]) %*% (es, W) >= 0 Apos <- cbind( diag(nScenarios), series) apos <- rep(0, nrow(Apos)) dpos <- rep(">=", nrow(Apos)) # 3 and 4: # The A_equal Equation Constraints: A_eq %*% x == a_eq eqsumW <- eqsumWConstraints(Data, spec, constraints) Aeq <- cbind( matrix(0, ncol=nScenarios, nrow=nrow(eqsumW)), matrix(eqsumW[, -1], ncol=nAssets) ) aeq <- eqsumW[, 1] deq <- rep("==", nrow(eqsumW)) # 5: # The e_s > = 0 Equation Constraints: Aes <- cbind(diag(nScenarios), matrix(0, nrow=nScenarios, ncol=nAssets)) aes <- rep(0, nrow(Aes)) des <- rep(">=", nrow(Aes)) # 6: # Group Constraints: A W >= a minsumW <- minsumWConstraints(Data, spec, constraints) if (is.null(minsumW)){ Aminsum <- aminsum <- dminsum <- NULL } else { Aminsum <- cbind( matrix(0, nrow=nrow(minsumW), ncol=nScenarios), minsumW[, -1, drop=FALSE] ) aminsum <- minsumW[, 1] dminsum <- rep(">=", nrow(minsumW)) } # 7: # Group Constraints: A W <= b maxsumW <- maxsumWConstraints(Data, spec, constraints) if (is.null(maxsumW)){ Amaxsum <- amaxsum <- dmaxsum <- NULL } else { Amaxsum <- cbind( matrix(0, nrow=nrow(maxsumW), ncol=nScenarios), maxsumW[, -1, drop=FALSE] ) amaxsum <- maxsumW[, 1] dmaxsum <- rep("<=", nrow(maxsumW)) } # Putting all Together: mat <- rbind(Aeq, Apos, Aneg, Aes, Aminsum, Amaxsum) rhs <- c(aeq, apos, aneg, aes, aminsum, amaxsum) dir <- c(deq, dpos, dneg, des, dminsum, dmaxsum) # Box Constraints: Upper and Lower Bounds as listn required ... minW <- minWConstraints(Data, spec, constraints) maxW <- maxWConstraints(Data, spec, constraints) nInd <- 1:(nScenarios+nAssets) bounds <- list( lower = list(ind = nInd, val = c(rep( 0, nScenarios), minW)), upper = list(ind = nInd, val = c(rep(Inf, nScenarios), maxW)) ) # What variable Types, All Continuous: types <- NULL # Should I minimize or maximize ? max <- FALSE # Return Value: list( obj = obj, mat = mat, dir = dir, rhs = rhs, types = types, max = max, bounds = bounds, verbose = FALSE, nScenarios = nScenarios, nAssets = nAssets, targetReturn = targetReturn, Alpha = NA, Type = Type) } ################################################################################ .rglpk.MAD <- function(obj, mat, dir, rhs, types, max, bounds, verbose, nScenarios, nAssets, targetReturn, Alpha, Type) { # A function implemented by Diethelm Wuertz # Description: # Rglpk MAD Solver # FUNCTION: # Solve - use Rglpk_solve_LP: optim <- Rglpk::Rglpk_solve_LP( obj = obj, mat = mat, dir = dir, rhs = rhs, types = types, max = max, bounds = bounds, verbose = verbose) # Extract Weights: weights <- .checkWeights(rev(rev(optim$solution)[1:nAssets])) attr(weights, "invest") = sum(weights) # Result: ans <- list( type = Type, solver = "Rglpk.MAD", optim = optim, weights = weights, solution = weights, targetReturn = targetReturn, targetRisk = -optim$optimum, objective = -optim$optimum, status = optim$status[[1]], message = "NA") # Return Value: ans } ################################################################################ fPortfolio/R/solve-Rampl.R0000644000175100001440000002213412410250204015130 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRampl.MV AMPL solver for a MV Long Only Portfolio # FUNCTION: DESCRIPTION: # solveRampl.CVAR AMPL solver for a CVAR Long Only Portfolio ################################################################################ solveRampl.MV <- function (data, spec, constraints="LongOnly") { # A function written by Diethelm Wuertz # Description: # A Mean-Variance (MV) Long Only portfolio solver # Note: # No other constraints are allowed. # Example: # data <- 100 * LPP2005.RET[, 1:6] # spec <- portfolioSpec() # setTargetReturn(spec) <- mean(data) # setSolver(spec) <- "solveRampl.MV" # solveRampl.MV(data, spec) # FUNCTION: # Check Consistency: stopifnot(getType(spec) == "MV") stopifnot(constraints == "LongOnly") # Force AMPL Settings: spec@ampl$ampl <- TRUE solver <- spec@ampl$solver project <- spec@ampl$project trace <- spec@ampl$trace # Get Portfolio Settings: Data <- portfolioData(data, spec) Sigma <- getSigma(Data) n <- nAssets <- getNAssets(Data) targetReturn <- getTargetReturn(spec) # Create AMPL Model File: amplModelOpen(project) model <- c( "# Quadratic Programming", "# Long Only Markowitz", "param nAssets;", "param mu{1..nAssets};", "param Sigma{1..nAssets, 1..nAssets};", "param targetReturn;", "var x{1..nAssets} >= 0;", "minimize Risk: sum {i in 1..nAssets} sum{j in 1..nAssets} x[i]*Sigma[i,j]*x[j];", "subject to Return: sum{i in 1..nAssets} mu[i]*x[i] = targetReturn;", "subject to Budget: sum{i in 1..nAssets} x[i] = 1;", NULL ) amplModelAdd(model, project) # Create AMPL Data File: amplDataOpen(project) amplDataAddValue(data="nAssets", value=n, project) amplDataAddVector(data="mu", vector=getMu(Data), project) amplDataAddMatrix(data="Sigma", matrix=getSigma(Data), project) amplDataAddValue(data="targetReturn", value=getTargetReturn(spec), project) # Create AMPL Run File: amplRunOpen(project) run <- c( paste("reset ;"), paste("option solver", solver, ";", sp = ""), paste("model ", project, ".mod ;", sep = ""), paste("data ", project, ".dat ;", sep = ""), paste("solve ;"), paste("display x > ", project, ".txt ;", sep = ""), paste("display solve_result_num > ", project, ".txt ;", sep = ""), paste("display solve_result > ", project, ".txt ;", sep = ""), paste("display solve_message > ", project, ".txt ;", sep = ""), paste("exit ;"), NULL ) amplRunAdd(run, project) # Exec AMPL: command <- paste("ampl -t -vs", paste(project, "run", sep=".")) solve <- system(command, intern=TRUE) # Read AMPL Output File: file <- paste(project, "txt", sep = ".") out <- scan(file, what = character(0), sep="\n", quiet=TRUE) # Get Weights: Index <- (grep(";", out) - 1)[1] splits <- strsplit(paste(out[2:Index], collapse=" "), " ")[[1]] solution <- as.numeric(splits[splits != ""])[seq(2, 2*n, by=2)] Index <- as.numeric(splits[splits != ""])[seq(1, 2*n, by=2)] solution[Index] <- solution # Get Status: status <- strsplit(out[grep("solve_result", out)], split=" ") statusCode <- status[[1]][3] statusMessage <- status[[2]][3] # Version: version <- system(paste(solver, "-v"), intern=TRUE) # Compose Result into a List: ans <- list( type = getType(spec), solver = getSolver(spec), optim = solve, weights = solution, targetReturn = targetReturn, targetRisk = sqrt(solution %*% Sigma %*% solution)[[1, 1]], objective = sqrt(solution %*% Sigma %*% solution)[[1, 1]], status = statusCode, message = statusMessage) class(ans) <- c("solver", "list") # Return Value: ans } ################################################################################ solveRampl.CVAR <- function(data, spec, constraints="LongOnly") { # A function written by Diethelm Wuertz # FUNCTION: # Portfolio Model # max CVaR # s.t. desired target Return # s.t. full Investement # s.t. long only positions # Check Consistency: stopifnot(getType(spec) == "CVAR") stopifnot(getSolver(spec) == "solveAMPLipoptCVAR") stopifnot(constraints == "LongOnly") # Force AMPL Settings: spec@ampl$ampl <- TRUE project <- spec@ampl$project trace <- spec@ampl$trace # Settings: Data <- portfolioData(data, spec) data <- getSeries(Data) n <- nAssets <- getNAssets(Data) nScenarios <- nrow(getSeries(Data)) Mean <- getMean(Data) targetReturn <- getTargetReturn(spec) alpha <- getAlpha(spec) Type <- getType(spec) project <- "ampl" solver <- "ipopt" # Model File: amplModelOpen(project) model <- c( "param alpha ;", "param nAssets ;", "param nScenarios ;", "param Mean{1..nAssets} ;", "param targetReturn ;", "param Data{1..nScenarios,1..nAssets} ;", "var weights{1..nAssets} ;", "var VaR ;", "var z{1..nScenarios};", "maximize Risk: VaR - ( sum{i in 1..nScenarios} z[i] ) / ( alpha * nScenarios ) ;", "subject to Return: sum{i in 1..nAssets} weights[i] * Mean[i] = targetReturn ;" , "subject to Weights{i in 1..nAssets}: weights[i] >= 0 ;", "subject to Budget: sum{i in 1..nAssets} weights[i] = 1 ;", "subject to Scenarios{k in 1..nScenarios}: -VaR + z[k] + sum{i in 1..nAssets} Data[k,i]*weights[i] >= 0 ;" , "subject to Z{i in 1..nScenarios}: z[i] >= 0 ;", NULL ) amplModelAdd(model, project) # Data File: amplDataOpen(project) amplDataAddValue(data="alpha", value=alpha, project) amplDataAddValue(data="nAssets", value=nAssets, project) amplDataAddValue(data="nScenarios", value=nScenarios, project) amplDataAddValue(data="targetReturn", value=targetReturn, project) amplDataAddVector(data="Mean", vector=Mean, project) amplDataAddMatrix(data="Data", matrix=data, project) # Run File: amplRunOpen(project) run <- c( paste("option solver cplex ;"), paste("model ", project, ".mod ;", sep = ""), paste("data ", project, ".dat ;", sep = ""), "solve ;", paste("display weights > ", project, ".txt ;", sep = ""), paste("display VaR > ", project, ".txt ;", sep = ""), paste("exit ;"), NULL) amplRunAdd(run, project) # Exec AMPL: command <- paste("ampl -t -vs", paste(project, "run", sep=".")) solve <- system(command, intern=TRUE) # Read AMPL Output File: file <- paste(project, "txt", sep = ".") out <- scan(file, what = character(0), sep="\n", quiet=TRUE) # Get Weights: Index <- (grep(";", out) - 1)[1] splits <- strsplit(paste(out[2:Index], collapse=" "), " ")[[1]] solution <- as.numeric(splits[splits != ""])[seq(2, 2*n, by=2)] Index <- as.numeric(splits[splits != ""])[seq(1, 2*n, by=2)] solution[Index] <- solution # Get Status: status <- strsplit(out[grep("solve_result", out)], split=" ") statusCode <- status[[1]][3] statusMessage <- status[[2]][3] # Version: version <- system(paste(solver, "-v"), intern=TRUE) # Result: ans <- list( type = "CVAR", solver = "solveRampl.CVAR", optim = optim, weights = weights, targetReturn = targetReturn, targetRisk = -optim$optimum, objective = -optim$optimum, status = optim$status[[1]], message = "") class(ans) <- c("solver", "list") # Return Value: ans } # ############################################################################# fPortfolio/R/00RmetricsPortfolio-package.R0000644000175100001440000000206012323217770020160 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for Rmetrics: # 1999-2011 - Diethelm Wuertz, GPL # 2007-2011 - Rmetrics Association, GPL # Diethelm Wuertz # for code accessed (or partly included) from other sources: # see copyright and license descriptions ################################################################################ fPortfolio/R/risk-budgeting.R0000644000175100001440000005327212330665056015674 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # pfolioReturn Returns portfolio returns # FUNCTION: DESCRIPTION: # sampleCOV Returns sample covariance risk # normalVaR Returns normal Value at Risk # modifiedVaR Returns modified Cornish Fisher VaR # sampleVaR Returns sammple VaR from historical quantiles # FUNCTION: DESCRIPTION: # budgetsSampleCOV Covariance risk contribution and budgets # budgetsNormalVAR Normal VaR risk contribution and budgets # budgetsModifiedVAR Modified VaR risk contribution and budgets # budgetsNormalES Normal ES (CVaR) risk contribution and budgets # budgetsModifiedES Modified ES (CVaR) risk contribution and budgets # UTILITIES: DESCRIPTION: # .M34.MM Internal fast computing of M3 and M4 # .run Returns execution time information # .Ipower Internal utility function to compute M3 # .derIpower Internal utility function to compute M4 # .myVaR ... to do # DEPRECATED: DESCRIPTION: # .covarRisk Computes covariance portfolio risk # .mcr Computes marginal contribution to covariance risk # .mcrBeta Computes beta, the rescaled mcr to covariance risk # .riskContributions Computes covariance risk contributions # .riskBudgets Computes covariance risk budgets ############################################################################### sampleCOV <- function(x) { # A function implemented by Diethelm Wuertz # Description: # Returns sample covariance risk # Arguments: # x - a 'timeSeries' object # FUNCTION: # Return Value: cov(x) } # ----------------------------------------------------------------------------- normalVaR <- function(x, alpha=0.05) { # A function implemented by Diethelm Wuertz # Description: # Returns normal Value at Risk # Arguments: # x - a 'timeSeries' object # FUNCTION: # Mean and Centered 2nd Moment: x.mean <- colMeans(x) x.centered <- t(t(x) - x.mean) m2 <- colMeans(x.centered^2) # Gaussian: q <- qnorm(alpha) # Return Value: x.mean + q * sqrt(m2) } # ----------------------------------------------------------------------------- modifiedVaR <- function(x, alpha=0.05) { # A function implemented by Diethelm Wuertz # Description: # Returns modified Cornish Fisher VaR # Arguments: # x - a 'timeSeries' object # Details: # Includes Code Borrowed from Peterson and Boudt, GPL # FUNCTION: # Mean and Centered Moments: x.mean <- colMeans(x) x.centered <- t(t(x) - x.mean) m2 <- colMeans(x.centered^2) m3 <- colMeans(x.centered^3) m4 <- colMeans(x.centered^4) skew <- m3 / sqrt(m2^3) kurt <- m4 / (m2*m2) - 3 # Cornish Fisher: z <- qnorm(alpha) q <- z + (z*z-1)*skew/6 + z*(z*z-3)*kurt/24 - z*(2*z*z-5)*skew*skew/36 # Return Value: x.mean + q * sqrt(m2) } # ----------------------------------------------------------------------------- sampleVaR <- function(x, alpha=0.05) { # A function implemented by Diethelm Wuertz # Description: # Returns sammple VaR from historical quantiles # Arguments: # x - a 'timeSeries' object # FUNCTION: # Return Value: colQuantiles(x, alpha) } # ----------------------------------------------------------------------------- budgetsSampleCOV <- function(x, weights, mu=NULL, Sigma=NULL) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - a 'timeSeries' object # Details: # Includes Code Borrowed from Peterson and Boudt, GPL # Rmetrics Re-Implementation # FUNCTION: # Risk: if(is.null(mu)) mu <- colMeans(x) if(is.null(Sigma)) Sigma <- cov(x) risk <- sqrt( t(weights) %*% Sigma %*% weights )[[1]] attr(risk, "estimator") <- substitute(FUN) # Risk Contributions: m2.pfolio <- (t(weights) %*% Sigma %*% weights)[[1]] dm2.pfolio <- as.vector(Sigma %*% weights) contribution <- dm2.pfolio/sqrt(m2.pfolio) * weights names(contribution) <- colnames(x) # Risk Budgets: budgets <- contribution/risk names(budgets) <- colnames(x) attr(budgets, "control") <- sum(budgets) # Return Value: list(riskCOV=risk, contribution=contribution, budgets=budgets) } # ----------------------------------------------------------------------------- budgetsNormalVAR <- function(x, weights, alpha=0.05, mu=NULL, Sigma=NULL) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - a 'timeSeries' object # Details: # Includes Code Borrowed from Peterson and Boudt, GPL # FUNCTION: # Risk: if(is.null(mu)) mu <- colMeans(x) if(is.null(Sigma)) Sigma <- cov(x) risk <- -(t(weights) %*% mu + qnorm(alpha) * sqrt( t(weights) %*% Sigma %*% weights))[[1]] attr(risk, "estimator") <- substitute(FUN) attr(risk, "alpha") <- alpha # Risk Contributions: m2.pfolio <- (t(weights) %*% Sigma %*% weights) dm2.pfolio <- as.vector(Sigma %*% weights) contribution <- - (mu + qnorm(alpha)* dm2.pfolio/sqrt(m2.pfolio)) * weights names(contribution) <- colnames(x) # Risk Budgets: budgets <- contribution/risk names(budgets) <- colnames(x) attr(budgets, "sumBudgets") <- sum(budgets) # Return Value: list(riskVAR=risk, contributionVAR=contribution, budgetsVAR=budgets) } # ----------------------------------------------------------------------------- budgetsModifiedVAR <- function(x, weights, alpha=0.05, mu=NULL, Sigma=NULL, M3=NULL, M4=NULL) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - a 'timeSeries' object # Details: # Includes code borrowed from Peterson and Boudt, GPL # FUNCTION: # Compute Moments: if(is.null(mu)) mu <- colMeans(x) if(is.null(Sigma)) Sigma <- cov(x) if(is.null(M3) || is.null(M4)) { MM <- .M34.MM(x, mu=mu) M3 <- MM$M3 M4 <- MM$M4 } # Risk: z <- qnorm(alpha) location <- t(weights) %*% mu pm2 <- t(weights) %*% Sigma %*% weights dpm2 <- as.vector(2 * Sigma %*% weights) pm3 <- weights %*% M3 %*% (weights %x% weights) dpm3 <- as.vector(3 * M3 %*% (weights %x% weights)) pm4 <- t(weights) %*% M4 %*% (weights %x% weights %x% weights) dpm4 <- as.vector(4 * M4 %*% (weights %x% weights %x% weights)) skew <- (pm3/pm2^(3/2))[[1]] exkurt <- (pm4/pm2^(2) - 3)[[1]] derskew <- (2 * (pm2^(3/2)) * dpm3 - 3 * pm3 * sqrt(pm2) * dpm2) / (2 * pm2^3) derexkurt <- ((pm2) * dpm4 - 2 * pm4 * dpm2)/(pm2^3) h <- z + (1/6) * (z^2 - 1) * skew h <- h + (1/24) * (z^3 - 3 * z) * exkurt - (1/36) * (2 * z^3 - 5 * z) * skew^2 risk <- -(location + h * sqrt(pm2)) # Risk Contribution: derGausVaR <- -as.vector(mu) - qnorm(alpha) * (0.5 * as.vector(dpm2))/sqrt(pm2) derMVaR <- derGausVaR + (0.5 * dpm2/sqrt(pm2)) * (-(1/6) * (z^2 - 1) * skew - (1/24) * (z^3 - 3 * z) * exkurt + (1/36) * (2 * z^3 - 5 * z) * skew^2) derMVaR <- derMVaR + sqrt(pm2) * (-(1/6) * (z^2 - 1) * derskew - (1/24) * (z^3 - 3 * z) * derexkurt + (1/36) * (2 * z^3 - 5 * z) * 2 * skew * derskew) contribution <- as.vector(weights) * as.vector(derMVaR) names(contribution) <- colnames(x) # Risk Budgets: budgets <- contribution/risk names(budgets) <- colnames(x) budgets attr(budgets, "sum(contribution)-risk") <- sum(contribution)-risk attr(budgets, "sum(budgets)") <- sum(budgets) # Return Value: list(modifiedVAR=risk, contribution=contribution, budgets=budgets) } # ----------------------------------------------------------------------------- budgetsNormalES <- function(x, weights, alpha=0.05, mu=NULL, Sigma=NULL) { # A function implemented by Diethelm Wuertz # Description: # x - a 'timeSeries' object # Arguments: # Details: # Includes Code Borrowed from Peterson and Boudt, GPL # FUNCTION: # Risk: if(is.null(mu)) mu <- colMeans(x) if(is.null(Sigma)) Sigma <- cov(x) location <- t(weights) %*% mu pm2 <- t(weights) %*% Sigma %*% weights dpm2 <- as.vector(2 * Sigma %*% weights) risk <- -location + dnorm(qnorm(alpha)) * sqrt(pm2)/alpha attr(risk, "estimator") <- substitute(FUN) attr(risk, "alpha") <- alpha # Contribution: derES <- -mu + (1/alpha) * dnorm(qnorm(alpha)) * (0.5 * dpm2)/sqrt(pm2) contribution <- weights * derES names(contribution) <- colnames(x) # Budgets: budgets <- contribution/risk names(budgets) <- colnames(x) attr(budgets, "sumBudgets") <- sum(budgets) # Return Value: list(normalES=risk, contribution=contribution, budgets=budgets) } # ----------------------------------------------------------------------------- budgetsModifiedES <- function(x, weights, alpha=0.05, mu=NULL, Sigma=NULL, M3=NULL, M4=NULL) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - a 'timeSeries' object # Details: # Includes code borrowed from Peterson and Boudt, GPL # FUNCTION: # Settings: if(is.null(mu)) mu <- colMeans(x) if(is.null(Sigma)) Sigma <- cov(x) if(is.null(M3) || is.null(M4)) { MM <- .M34.MM(x, mu=mu) M3 <- MM$M3 M4 <- MM$M4 } # Risk: z <- qnorm(alpha) location <- t(weights) %*% mu pm2 <- (t(weights) %*% Sigma %*% weights)[[1]] dpm2 <- as.vector(2 * Sigma %*% weights) pm3 <- (weights %*% M3 %*% (weights %x% weights))[[1]] dpm3 <- as.vector(3 * M3 %*% (weights %x% weights)) pm4 <- (t(weights) %*% M4 %*% (weights %x% weights %x% weights))[[1]] dpm4 <- as.vector(4 * M4 %*% (weights %x% weights %x% weights)) skew <- (pm3/pm2^(3/2))[[1]] exkurt <- (pm4/pm2^(2) - 3)[[1]] derskew <- (2 * (pm2^(3/2)) * dpm3 - 3 * pm3 * sqrt(pm2) * dpm2)/(2 * pm2^3) derexkurt <- ((pm2) * dpm4 - 2 * pm4 * dpm2)/(pm2^3) h <- z + (1/6) * (z^2 - 1) * skew h <- h + (1/24) * (z^3 - 3 * z) * exkurt - (1/36) * (2 * z^3 - 5 * z) * skew^2 derh <- (1/6) * (z^2 - 1) * derskew + (1/24) * (z^3 - 3 * z) * derexkurt - (1/18) * (2 * z^3 - 5 * z) * skew * derskew E <- dnorm(h) E <- E + (1/24) * (.Ipower(4, h) - 6 * .Ipower(2, h) + 3 * dnorm(h)) * exkurt E <- E + (1/6) * (.Ipower(3, h) - 3 * .Ipower(1, h)) * skew E <- E + (1/72) * (.Ipower(6, h) - 15 * .Ipower(4, h) + 45 * .Ipower(2, h) - 15 * dnorm(h)) * (skew^2) E <- E/alpha risk <- MES <- -location + sqrt(pm2) * E # Risk Contributions: derMES <- -mu + 0.5 * (dpm2/sqrt(pm2)) * E derE <- (1/24) * (.Ipower(4, h) - 6 * .Ipower(2, h) + 3 * dnorm(h)) * derexkurt derE <- derE + (1/6) * (.Ipower(3, h) - 3 * .Ipower(1, h)) * derskew derE <- derE + (1/36) * (.Ipower(6, h) - 15 * .Ipower(4, h) + 45 * .Ipower(2, h) - 15 * dnorm(h)) * skew * derskew X <- -h * dnorm(h) + (1/24) * (.derIpower(4, h) - 6 * .derIpower(2, h) - 3 * h * dnorm(h)) * exkurt X <- X + (1/6) * (.derIpower(3, h) - 3 * .derIpower(1, h)) * skew X <- X + (1/72) * (.derIpower(6, h) - 15 * .derIpower(4, h) + 45 * .derIpower(2, h) + 15 * h * dnorm(h)) * skew^2 derE <- derE + derh * X derE <- derE/alpha derMES <- derMES + sqrt(pm2) * derE contribution <- as.vector(weights) * as.vector(derMES) names(contribution) <- colnames(x) # Risk Budgets: budgets <- contribution/risk names(budgets) <- colnames(x) attr(budgets, "sumBudgets") <- sum(budgets) # Return Value: list(modifedES=risk, contribution=contribution, budgets=budgets) } ############################################################################### .M34.MM <- function (x, mu=NULL) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - a 'timeSeries' object # Details: # Includes Code Borrowed from Peterson and Boudt, GPL # Fast Rmetrics Implementation: n <- ncol(x) m <- nrow(x) if(is.null(mu)) mu <- colMeans(x) M3 <- matrix(rep(0, n^3), nrow=n, ncol=n^2) M4 <- matrix(rep(0, n^4), nrow=n, ncol=n^3) centret <- series(x) - matrix(rep(mu, each=m), ncol=n) for (i in c(1:m)) { cent <- centret[i, ] tcent <- t(cent) M <- (cent %*% tcent) %x% tcent M3 <- M3 + M M4 <- M4 + M %x% tcent } # Return Value: list(M3=M3/m, M4=M4/m, mu=mu) } # ----------------------------------------------------------------------------- .run <- function(FUN, times=10, mult=100, ...) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # FUNCTION: # Timing: fun <- match.fun(FUN) now <- Sys.time() for (i in 1:as.integer(times)) ans <- fun(...) done <- Sys.time() time <- mult * as.numeric(done - now) # Print Timing Results: cat("Timing:\n") print(c(sec=round(time,0), times=times, mult=mult, runs=times*mult)) cat("\nResults:\n\n") # Return Value: ans } # ----------------------------------------------------------------------------- .Ipower <- function (power, h) { # Description: # Arguments: # Details: # A function borrowed from PerformanceAnalytics, GPL fullprod <- 1 if ((power%%2) == 0) { pstar <- power/2 for (j in c(1:pstar)) fullprod <- fullprod * (2 * j) I <- fullprod * dnorm(h) for (i in c(1:pstar)) { prod <- 1 for (j in c(1:i)) prod <- prod * (2 * j) I <- I + (fullprod/prod) * (h^(2 * i)) * dnorm(h) } } else { pstar <- (power - 1)/2 for (j in c(0:pstar)) { fullprod = fullprod * ((2 * j) + 1) } I <- -fullprod * pnorm(h) for (i in c(0:pstar)) { prod = 1 for (j in c(0:i)) prod = prod * ((2 * j) + 1) I <- I + (fullprod/prod) * (h^((2 * i) + 1)) * dnorm(h) } } return(I) } # ----------------------------------------------------------------------------- .derIpower <- function (power, h) { # Description: # Arguments: # Details: # A function borrowed from PerformanceAnalytics, GPL fullprod <- 1 if ((power%%2) == 0) { pstar <- power/2 for (j in c(1:pstar)) fullprod = fullprod * (2 * j) I <- -fullprod * h * dnorm(h) for (i in c(1:pstar)) { prod = 1 for (j in c(1:i)) prod = prod * (2 * j) I <- I + (fullprod/prod) * (h^(2 * i - 1)) * (2 * i - h^2) * dnorm(h) } } else { pstar = (power - 1)/2 for (j in c(0:pstar)) fullprod <- fullprod * ((2 * j) + 1) I <- -fullprod * dnorm(h) for (i in c(0:pstar)) { prod = 1 for (j in c(0:i)) prod <- prod * ((2 * j) + 1) I <- I + (fullprod/prod) * (h^(2 * i) * (2 * i + 1 - h^2)) * dnorm(h) } } return(I) } # ----------------------------------------------------------------------------- .myVaR <- function(x, alpha=0.05, method=c("normal", "modified", "sample")) { # A function implemented by Diethelm Wuertz # todo ... # Funcion Selection: fun <- match.fun(paste(match.arg(method), "VaR", sep="")) # Return Value: fun(x, alpha) } ############################################################################### # DEPRECATED - DO NOT REMOVE - REQUIRED BY PACKAGE appRmetricsHandbook .covarRisk <- function(data, weights=NULL, FUN="cov", ...) { # A function implemented by Diethelm Wuertz # Description: # Computes covariance portfolio risk # Arguments: # data - a multivariate timeSeries object of financial returns # weights - numeric vector of portfolio weights # FUN - a covariance estimator, which returns a matrix of # covariance estimates, by default the sample covariance # ... - Optional arguments passed to the function FUN # Example: # covarRisk(data) # FUNCTION: # Covariance Risk: covFun <- match.fun(FUN) COV <- covFun(data) # Portfolio Weights: N <- ncol(COV) if (is.null(weights)) weights = rep(1/N, N) names(weights) <- colnames(COV) # Covariance Portfolio Risk: covarRisk <- sqrt( t(weights) %*% COV %*% weights )[[1, 1]] # Return Value: covarRisk } # ----------------------------------------------------------------------------- .mcr <- function(data, weights=NULL, FUN="cov", ...) { # A function implemented by Diethelm Wuertz # Description # Computes marginal contribution to covariance risk # Arguments: # data - a multivariate timeSeries object of financial returns # weights - numeric vector of portfolio weights # FUN - a covariance estimator, which returns a matrix of # covariance estimates, by default the sample covariance # ... - Optional arguments passed to the function FUN # Details: # The formula are implemented according to Goldberg et al., # see also R script assetsPfolio.R # References: # Lisa Goldberg et al., Extreme Risk Management, 2009 # Scherer and Martin, Introduction to modern portfolio Optimimization # Example: # data <- assetsSim(100, 6); mcr(data) # FUNCTION: # Covariance Risk: covFun <- match.fun(FUN) COV <- covFun(data) N <- ncol(data) if (is.null(weights)) weights <- rep(1/N, N) # Marginal Contribution to Risk mcr <- (COV %*% weights)[, 1] / .covarRisk(data, weights, FUN, ...) names(mcr) <- colnames(data) # Return Value: mcr } # ----------------------------------------------------------------------------- .mcrBeta <- function(data, weights=NULL, FUN="cov", ...) { # A function implemented by Diethelm Wuertz # Description: # Computes beta, the rescaled marginal contribution to covariance risk # Arguments: # data - a multivariate timeSeries object of financial returns # weights - numeric vector of portfolio weights # FUN - a covariance estimator, which returns a matrix of # covariance estimates, by default the sample covariance # ... - Optional arguments passed to the function FUN # Example: # .mcrBeta(data) # FUNCTION: # Portfolio Beta: beta <- .mcr(data, weights, FUN = FUN, ...) / .covarRisk(data, weights, FUN = FUN, ...) # Return Value: beta } # ----------------------------------------------------------------------------- .riskContributions <- function(data, weights=NULL, FUN="cov", ...) { # A function implemented by Diethelm Wuertz # Description: # Computes covariance risk contributions # Arguments: # data - a multivariate timeSeries object of financial returns # weights - numeric vector of portfolio weights # FUN - a covariance estimator, which returns a matrix of # covariance estimates, by default the sample covariance # ... - Optional arguments passed to the function FUN # Example: # .riskContributions(data) # FUNCTION: # Risk Contributions: if (is.null(weights)) { N <- ncol(data) weights <- rep(1/N, times = N) } riskContributions <- weights * .mcr(data, weights, FUN, ...) # Return Value: riskContributions } # ----------------------------------------------------------------------------- .riskBudgets <- function(data, weights=NULL, FUN="cov", ...) { # A function implemented by Diethelm Wuertz # Description: # Computes covariance risk budgets # Arguments: # data - a multivariate timeSeries object of financial returns # weights - numeric vector of portfolio weights # FUN - a covariance estimator, which returns a matrix of # covariance estimates, by default the sample covariance # ... - Optional arguments passed to the function FUN # Example: # data <- 100*LPP2005.RET[, 1:6]; .riskBudgets(data) # FUNCTION: # Risk Budgets: riskBudgets <- .riskContributions(data, weights, FUN, ...) / .covarRisk(data, weights, FUN, ...) # Return Value: riskBudgets } ############################################################################### fPortfolio/R/frontier-portfolioPlots.R0000644000175100001440000006403212323217770017635 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # frontierPlot Plots efficient frontier # minvariancePoints Adds minimum variance point # cmlPoints Adds market portfolio # cmlLines Adds capital market Line # tangencyPoints Adds tangency portfolio point # tangencyLines Adds tangency line # equalWeightsPoints Adds point of equal weights portfolio # singleAssetPoints Adds points of single asset portfolios # twoAssetsLines Adds EF for all combinations of two assets # sharpeRatioLines Adds Sharpe ratio line # monteCarloPoints Adds randomly produced feasible portfolios # FUNCTION: DESCRIPTION: # frontierPlotControl Sets frontier plot control parameters # FUNCTION: DESCRIPTION: # tailoredFrontierPlot Tailored frontier plot with addons ################################################################################ frontierPlot <- function(object, frontier = c("both", "lower", "upper"), col = c("black", "grey"), add = FALSE, labels = TRUE, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, title = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots the efficient frontier # Arguments: # FUNCTION: # Check Settings: stopifnot(length(col) == 2) # Settings: frontier <- match.arg(frontier) fullFrontier = frontierPoints(object, frontier = "both", return = return, risk = risk, auto = auto) upperFrontier <- frontierPoints(object, frontier = "upper", return = return, risk = risk, auto = auto) lowerFrontier <- frontierPoints(object, frontier = "lower", return = return, risk = risk, auto = auto) # Check for 'xlim' Argument: Arg <- match.call(expand.dots = TRUE) m <- match(c("xlim", "ylim"), names(Arg), Arg) xArg <- as.character(Arg[c(1, m)])[2] yArg <- as.character(Arg[c(1, m)])[3] # Plot: if(xArg == "NULL" & yArg == "NULL") { yLim <- range(fullFrontier[, 2]) xRange <- range(fullFrontier[, 1]) xDiff <- diff(xRange) xLim <- c(xRange[1] - 2.5*xDiff/10, xRange[2] + xDiff/10) # Plot: if(!add){ if(frontier == "upper" | frontier == "both") { plot(upperFrontier, col = col[1], xlim = xLim, ylim = yLim, ann = FALSE, ...) } else { if( frontier == "both") { points(fullFrontier, col = col[2], xlim = xLim, ylim = yLim, ...) } if(frontier == "lower" ) { plot(lowerFrontier, col = col[2], xlim = xLim, ylim = yLim, ann = FALSE, ...) } } } if(frontier == "upper" | frontier == "both") { points(upperFrontier, col = col[1], ...) } if(frontier == "lower" | frontier == "both") { points(lowerFrontier, col = col[2], ...) } } else if (xArg != "NULL" & yArg == "NULL") { # In this case only xlim is specified in the argument list yLim = range(fullFrontier[, 2]) # Plot: if(!add){ if(frontier == "upper" | frontier == "both") { plot(upperFrontier, col = col[1], ylim = yLim, ann = FALSE, ...) } else { if( frontier == "both") { points(fullFrontier, col = col[2], ylim = yLim, ...) } if(frontier == "lower" ) { plot(fullFrontier, col = col[2], ylim = yLim, ann = FALSE, ...) } } } if(frontier == "upper" | frontier == "both") { points(upperFrontier, col = col[1], ...) } if(frontier == "lower" | frontier == "both") { points(lowerFrontier, col = col[2], ...) } } else if(xArg == "NULL" & yArg != "NULL") { # In this only ylim is specified in the argument list xRange = range(fullFrontier[, 1]) xDiff = diff(xRange) xLim = c(xRange[1] - 2.5*xDiff/10, xRange[2] + xDiff/10) # Plot: if(!add){ if(frontier == "upper" | frontier == "both") { plot(upperFrontier, col = col[1], xlim = xLim, ann = FALSE, ...) } else { if( frontier == "both") { points(fullFrontier, col = col[2], xlim = xLim, ...) } if(frontier == "lower" ) { plot(lowerFrontier, col = col[2], xlim = xLim, ann = FALSE,...) } } } if(frontier == "upper" | frontier == "both") { points(upperFrontier, col = col[1], ...) } if(frontier == "lower" | frontier == "both") { points(lowerFrontier, col = col[2], ...) } } else if (xArg != "NULL" & yArg != "NULL"){ # If both xlim and ylim are not defined in argument list ... if(!add){ if(frontier == "upper" | frontier == "both") { plot(fullFrontier, type = "n", ann = FALSE, ...) points(upperFrontier, col = col[1], ...) } if(frontier == "both") { points(lowerFrontier, col = col[2], ...) } if(frontier == "lower") { plot(lowerFrontier, col = col[2], ann = FALSE, ...) } } else{ if(frontier == "upper" | frontier == "both") { points(upperFrontier, col = col[1], ...) } if(frontier == "lower" | frontier == "both") { points(lowerFrontier, col = col[2], ...) } } } # Add Title: if (title) { labs = attr(fullFrontier, "control") title( main = "Efficient Frontier", xlab = paste("Target Risk[", labs[1], "]", sep = ""), ylab = paste("Target Return[", labs[2], "]", sep = "")) } # Add Rmetrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") # Return Value: invisible(fullFrontier) } # ------------------------------------------------------------------------------ minvariancePoints <- function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds the minimum risk point to a MV and CVaR portfolio plot # Arguments: # FUNCTION: # Match Arguments: return <- match.arg(return) risk <- match.arg(risk) # Get Portfolio Slots: data <- getSeries(object) spec <- getSpec(object) constraints <- getConstraints(object) # Add Minimum Variance Point: mvPortfolio <- minvariancePortfolio(data, spec, constraints) assets <- frontierPoints(mvPortfolio, return = return, risk = risk, auto = auto) points(assets, ...) # Return Value: invisible(assets) } # ------------------------------------------------------------------------------ cmlPoints <- function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds the capital market line to a portfolio plot # Arguments: # FUNCTION: # Match Arguments: return <- match.arg(return) risk <- match.arg(risk) # Get Portfolio Statistics: data <- getSeries(object) spec <- getSpec(object) constraints <- getConstraints(object) # Add Capital Market Line Tangency Point: cmlPortfolio <- tangencyPortfolio(data, spec, constraints) assets <- frontierPoints(cmlPortfolio, return = return, risk = risk, auto = auto) points(assets, ...) # Return Value: invisible(assets) } # ------------------------------------------------------------------------------ cmlLines <- function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds the capital market line to a portfolio plot # Arguments: # FUNCTION: # Match Arguments: return <- match.arg(return) risk <- match.arg(risk) # Get Portfolio Statistics: data <- getSeries(object) spec <- getSpec(object) constraints <- getConstraints(object) # Add Capital Market Line: cmlPortfolio <- tangencyPortfolio(data, spec, constraints) riskFreeRate <- getRiskFreeRate(spec) slope <- ((getTargetReturn(cmlPortfolio)[, "mean"] - riskFreeRate) / getTargetRisk(cmlPortfolio@portfolio)[, "Cov"]) if(slope > 0) { abline(riskFreeRate, slope, ...) } else { warning("CML Line does not exist") } # Return Value: invisible(slope) } # ------------------------------------------------------------------------------ tangencyPoints <- function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds tangency point and line to a MV and CVaR portfolio plot # Arguments: # FUNCTION: # Match Arguments: return <- match.arg(return) risk <- match.arg(risk) # Get Portfolio Slots: data <- getSeries(object) spec <- getSpec(object) constraints <- getConstraints(object) # Compute Tangency Portfolio: tgPortfolio <- tangencyPortfolio(data, spec, constraints) # Add Tangency Point: assets <- frontierPoints(tgPortfolio, return = return, risk = risk, auto = auto) points(assets, ...) # Return Value: invisible(assets) } # ------------------------------------------------------------------------------ tangencyLines <- function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds tangency point and line to a MV and CVaR portfolio plot # Arguments: # FUNCTION: # Match Arguments: return = match.arg(return) risk = match.arg(risk) # Get Portfolio Slots: data <- getSeries(object) spec <- getSpec(object) constraints <- getConstraints(object) riskFreeRate <- getRiskFreeRate(object) # Compute Tangency Portfolio: tgPortfolio = tangencyPortfolio(data, spec, constraints) # Add Tangency Line: assets <- frontierPoints(tgPortfolio, return = return, risk = risk, auto = auto) slope <-( assets[2] - riskFreeRate ) / assets[1] if (slope > 0) { abline(riskFreeRate, slope, ...) } else { warning("Tangency point does not exist") } # Return Value: invisible(list(slope = slope, assets = assets)) } # ------------------------------------------------------------------------------ equalWeightsPoints = function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds equal weights portfolio to a portfolio plot # Arguments: # FUNCTION: # Match Arguments: return <- match.arg(return) risk <- match.arg(risk) # Get Portfolio Statistics: data <- getSeries(object) spec <- getSpec(object) constraints <- getConstraints(object) numberOfAssets <- getNAssets(object) # Set Equal Weights: setWeights(spec) <- rep(1/numberOfAssets, times = numberOfAssets) # Add Equal Weights Portfolio: ewPortfolio <- feasiblePortfolio(data, spec, constraints) assets <- frontierPoints(ewPortfolio, return = return, risk = risk, auto = auto) points(assets, ...) # Return Value: invisible(assets) } # ------------------------------------------------------------------------------ singleAssetPoints <- function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds all single assets returns and risks to a portfolio plot # Arguments: # FUNCTION: # Add Single Assets: Statistics <- getStatistics(object) Type <- getType(object) # Match Arguments: return <- match.arg(return) risk <- match.arg(risk) # Get auto Risk: if (auto) { return = "mu" Type = getType(object) Estimator = getEstimator(object) if (Type == "MV") risk = "Cov" if (Type == "MV" & Estimator != "covEstimator") risk = "Sigma" if (Type == "QLPM") risk = "Sigma" if (Type == "CVaR") risk = "CVaR" } # Extract Return: if (return == "mean") { Return = Statistics$mean } else if (return == "mu") { Return = Statistics$mu } # Extract Risk: if (risk == "Cov") { Risk = sqrt(diag(Statistics$Cov)) } else if (risk == "Sigma") { Risk = sqrt(diag(Statistics$Sigma)) } else if (risk == "CVaR") { nAssets = getNAssets(object) Data = getSeries(object) alpha = getAlpha(object) Risk = NULL for (i in 1:nAssets) Risk = c(Risk, -.cvarRisk(Data[ ,i], 1, alpha)) } else if (risk == "VaR") { nAssets = getNAssets(object) Data = getSeries(object) alpha = getAlpha(object) Risk = NULL for (i in 1:nAssets) Risk = c(Risk, -.varRisk(Data[ ,i], 1, alpha)) } Risk = as.vector(Risk) # Add Points: assets = cbind(targetRisk = Risk, targetReturn = Return) attr(assets, "control") <- c(targetRisk = risk, targetReturn = return, auto = as.character(auto)) points(assets, ...) # Return Value: invisible(assets) } # ------------------------------------------------------------------------------ twoAssetsLines <- function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds efficient long-only frontier of all portfolio pairs # Arguments: # Note: # Only supported for "Short" and "LongOnly" Constraints! # FUNCTION: # Supported ? check <- rev(attr(object@constraints, "model"))[1] # Match Arguments: return <- match.arg(return) risk <- match.arg(risk) # Get Portfolio Statistics: data <- getSeries(object) Data <- getData(object) mu <- getMu(Data) Sigma <- getSigma(Data) spec <- getSpec(object) constraints <- getConstraints(object) # Add Frontiers for all Two-Assets Portfolios: N <- getNAssets(object) setWeights(spec) = NULL for (i in 1:(N-1) ) { for (j in (i+1):N ) { index = c(i, j) data2 = data[, index] Data2 = portfolioData(data2, spec) Data2@statistics$mu <- mu[index] Data2@statistics$Sigma <- Sigma[index, index] ans = portfolioFrontier(data = Data2, spec = spec) lines(frontierPoints(ans, return = return, risk = risk, auto = auto), ...) } } # Return Value: invisible() } # ------------------------------------------------------------------------------ sharpeRatioLines <- function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds Sharpe Ratio # Arguments: # FUNCTION: # Match Arguments: return = match.arg(return) risk = match.arg(risk) # Get Portfolio Slots: data <- getSeries(object) spec <- getSpec(object) constraints <- getConstraints(object) riskFreeRate <- getRiskFreeRate(object) Type <- getType(object) # Efficient Frontier: frontPoints <- frontierPoints(object, frontier = "upper", return = return, risk = risk, auto = auto) x <- frontPoints[, 1] y <- frontPoints[, 2] - riskFreeRate # Tangency Portfolio: tangencyPortfolio <- tangencyPortfolio(data, spec, constraints) # x.tg = getTargetReturn(tangencyPortfolio@portfolio)["mean"] x.tg = frontierPoints(tangencyPortfolio, return = return, risk = risk, auto = auto)[, 2] # Normalization to fit in EF Plot: norm <- x.tg / max(y/x) index <- 2:length(x) #index = index[diff(x) > 0] x <- x[index] y <- y[index] y.norm <- (y/x*norm) assets <- cbind(x, y.norm) lines(x, y.norm, ...) # Search for Maximum: index <- which.max(y.norm) points(x[index], y.norm[index], col = "cyan", cex = 1.5) # Add Tailored Labels - 2 may be a good Number ... x.tg <- x.tg[index] norm2 <- x.tg / max(y) Range <- range(y/x * norm) # Take a reasonable number of significant digits to plot, e.g. 2 ... nPrecision <- 3 Labels <- signif(Range, nPrecision) axis(4, at = Range, labels = c(" ", " "), cex.axis = 0.75) axis(4, at = mean(Range), labels = paste(Labels[1], " ", Labels[2]), cex.axis = 0.75) # Add Axis Labels and Title: mtext("Sharpe Ratio", side = 4, line = 2, cex = 0.75) # Return Value: invisible(assets) } # ------------------------------------------------------------------------------ monteCarloPoints <- function(object, mcSteps = 5000, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Adds randomly feasible portfolios to a plot # Arguments: # FUNCTION: # Match Arguments: return = match.arg(return) risk = match.arg(risk) # Get Portfolio Statistics: Statistics = getStatistics(object) Type = getType(object) mu = Statistics$mu Sigma = Statistics$Sigma N = length(mu) # Get Specification: if (Type == "MV") { # Get Constraints Model: Model = rev(attr(object@constraints, "model"))[1] Model = "LongOnly" if (Model == "Short" | any(getConstraints(object) == "Short")) { # Monte Carlo Loop - Short: for (k in 1:mcSteps) { s = sign(rnorm(N, mean = rnorm(1))) weights = s * abs(rcauchy(N)) weights = weights / sum(weights) Return = as.numeric(mu %*% weights) Risk = sqrt( as.numeric( t(weights) %*% Sigma %*% (weights) ) ) points(Risk, Return, ...) } } else if (Model == "LongOnly" | any(getConstraints(object) == "LongOnly")) { # Monte Carlo Loop - Long Only: for (k in 1:mcSteps) { weights = abs(rcauchy(N)) weights = weights / sum(weights) Return = as.numeric(mu %*% weights) Risk = sqrt( as.numeric( t(weights) %*% Sigma %*% (weights) ) ) points(Risk, Return, ...) } } else { cat("\n\tOnly for Short and LongOnly Portfolios\n") } } else if (Type == "CVaR") { # Monte Carlo Loop - Long Only: x = getSeries(object) alpha = getAlpha(object) for (k in 1:mcSteps) { weights = abs(rcauchy(N)) weights = weights / sum(weights) Return = as.numeric(mu %*% weights) Risk = .cvarRisk(x, weights, alpha) points(-Risk, Return, ...) } } # Return Value: invisible() } ################################################################################ frontierPlotControl <- function( # Colors: sharpeRatio.col = "blue", minvariance.col = "red", tangency.col = "steelblue", cml.col = "green", equalWeights.col = "blue", singleAsset.col = "topo.colors", twoAssets.col = "grey", monteCarlo.col = "black", # Point Sizes: minvariance.cex = 1.25, tangency.cex = 1.25, cml.cex = 1.25, equalWeights.cex = 1.25, singleAsset.cex = 1.25, twoAssets.cex = 0.01, monteCarlo.cex = 0.01, sharpeRatio.cex = 0.1, # Limits: xlim = NULL, ylim = NULL, # MC Steps: mcSteps = 5000, # Pie Settings: pieR = NULL, piePos = NULL, pieOffset = NULL ) { # A function implemented by Diethelm Wuertz # Description: # Sets frontier plot control parameters # Arguments: # FUNCTION: # Return Value: list( # Colors: sharpeRatio.col = sharpeRatio.col, minvariance.col = minvariance.col, tangency.col = tangency.col, cml.col = cml.col, equalWeights.col = equalWeights.col, singleAsset.col = singleAsset.col, twoAssets.col = twoAssets.col, monteCarlo.col = monteCarlo.col, # Point Sizes: minvariance.cex = minvariance.cex, tangency.cex = tangency.cex, cml.cex = cml.cex, equalWeights.cex = equalWeights.cex, singleAsset.cex = singleAsset.cex , twoAssets.cex = twoAssets.cex, monteCarlo.cex = monteCarlo.cex, sharpeRatio.cex = sharpeRatio.cex, # Limits: xlim = xlim, ylim = ylim, # MC Steps: mcSteps = 5000, # Pie Settings: pieR = pieR, piePos = piePos, pieOffset = pieOffset ) } ################################################################################ tailoredFrontierPlot <- function(object, return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), mText = NULL, col = NULL, xlim = NULL, ylim = NULL, twoAssets = FALSE, sharpeRatio = TRUE, title = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Creates an easy to use tailored frontier plot # Arguments: # object - a portfolio object # mtext - not used # FUNCTION: # 1. Plot the Frontier, add margin text, grid and ablines: offset <- 0.10 risk <- match.arg(risk) return <- match.arg(return) # x - Range: if (is.null(xlim)) { if (risk == "Cov") { xmax <- max(sqrt(diag(getCov(object)))) } if (risk == "Sigma") { xmax <- max(sqrt(diag(getSigma(object)))) } if (risk == "CVaR") { alpha <- getAlpha(object) quantiles <- colQuantiles(getSeries(object), prob = alpha) n.max <- which.max(-quantiles) r <- getSeries(object)[, n.max] r <- r[r < quantiles[n.max]] xmax <- -mean(r) } if (risk == "VaR") { xmax <- max(-colQuantiles(getSeries(object), prob = alpha)) } xlim <- c(0, xmax) Xlim <- c(xlim[1]-diff(xlim)*offset, xlim[2]+diff(xlim)*offset) } else { Xlim <- xlim } # y - Range: if (is.null(ylim)) { if (return == "mean") { ylim <- range(getMean(object)) } else { ylim <- range(getMu(object)) } Ylim <- c(ylim[1]-diff(ylim)*offset, ylim[2]+diff(ylim)*offset) } else { Ylim = ylim } # Frontier Plot: frontierPlot(object, labels = FALSE, return = return, risk = risk, auto = FALSE, xlim = Xlim, ylim = Ylim, title = title, pch = 19, ...) # Add Grid: grid() # Add Center-Hair Cut: abline(h = 0, col = "grey") abline(v = 0, col = "grey") # 2. Add minimum risk (variance) Portfolio Point: data <- getData(object) spec <- getSpec(object) constraints <- getConstraints(object) mvPortfolio <- minvariancePortfolio(data, spec, constraints) minvariancePoints(object, return = return, risk = risk, auto = FALSE, pch = 19, col = "red") # 3. Add Tangency Portfolio Point and Tangency Line: tangencyPoints(object, return = return, risk = risk, auto = FALSE, pch = 19, col = "blue") tangencyLines(object, return = return, risk = risk, auto = FALSE, col = "blue") # 4. Add Equal Weights Portfolio: xy <- equalWeightsPoints(object, return = return, risk = risk, auto = FALSE, pch = 15, col = "grey") text(xy[, 1]+diff(xlim)/20, xy[, 2]+diff(ylim)/20, "EWP", font = 2, cex = 0.7) # 5. Add all Assets Points: if (is.null(col)) col = rainbow(6) xy <- singleAssetPoints(object, return = return, risk = risk, auto = FALSE, cex = 1.5, col = col, lwd = 2) text(xy[, 1]+diff(xlim)/20, xy[, 2]+diff(ylim)/20, rownames(xy), font = 2, cex = 0.7) # 6. Add optionally all Two Assets Lines if (twoAssets) { twoAssetsLines(object, return = return, risk = risk, auto = FALSE, lty = 3, col = "grey") } # 6. Add Sharpe Ratio Line: if(sharpeRatio) { sharpeRatioLines(object, return = return, risk = risk, auto = FALSE, col = "orange", lwd = 2) } # Add Rmetrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") # Return Value: invisible(list(object=object, xlim=Xlim, ylim=Ylim)) } ################################################################################ fPortfolio/R/backtest-pfolioBacktestSpec.R0000644000175100001440000000533412323217770020332 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # portfolioBacktest Returns an object of class fPFOLIOBACKTEST ################################################################################ portfolioBacktest <- function( windows = list( windows = "equidistWindows", params = list( horizon = "12m")), strategy = list( strategy = "tangencyStrategy", params = list()), smoother = list( smoother = "emaSmoother", params = list( doubleSmoothing = TRUE, lambda = "3m", skip = 0, initialWeights = NULL)), messages = list() ) { # A function implemented by William Chen and Diethelm Wuertz # Description: # Specifies a portfolio to be optimized from scratch # Example: # portfolioBacktest() # Arguments: # windows - rolling windows slot: # windows - the name of the rollings windows function # params - parameter list for windows settings: # horizon - length of the rolling windows # strategy - portfolio strategy slot: # strategy - the name of the portfolio strategy function # params - parameter list for strategy settings: # smoother - smoother approach slot: # smoother - the name of the portfolio weights smoother function # params - parameter list for smoother settings: # doubleSmoothing - a flag sould we double smooth the weights? # lambda - length of the ema smoothing parameter # skip - hoqw many periods should be skipped for smoothing ? # initialWeights - vector of initial weights # FUNCTION: # Return Value: new("fPFOLIOBACKTEST", windows = windows, strategy = strategy, smoother = smoother, messages = messages) } ################################################################################ fPortfolio/R/object-setSpec.R0000644000175100001440000002327012620132672015616 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # setType<- Sets type of portfolio optimization # setOptimize<- Sets what to optimze, minRisk or maxRetururn # setEstimator<- Sets name of mean-covariance estimator # setTailRisk<- Sets tail dependency matrix # setParams<- Sets optional model parameters # FUNCTION: DESCRIPTION: # setWeights<- Sets weights vector # setTargetReturn<- Sets target return value # setTargetRisk<- Sets target return value # setRiskFreeRate<- Sets risk-free rate value # setNFrontierPoints<- Sets number of frontier points # setStatus<- Sets portfolio status information # FUNCTION: DESCRIPTION: # setSolver<- Sets name of desired solver # setObjective<- Sets objective function name # setTrace<- Sets solver's trace flag ################################################################################ "setType<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the portfolio type for a portfolio structure # Notes: # What types are valid? # MV Standard Mean-Variance Portfolio # Objective = Covariance Risk # Constraints = Budget 1'*W = 1 # Allowed Constraints: Box + Group # CVaR Standard Mean-CVaR portfolio # Objective = Linearized CVaR Risk # Constraints = Budget 1'*W = 1 # Allowed Constraints: Box + Group # Arguments: # FUNCTION: # Type ? spec@model$type <- value message("Solver set to solveRquadprog") # Set Solver: if (value == "MV") { setSolver(spec) <- "solveRquadprog" message("setSolver: solveRquadprog") } if (value == "CVaR") { setSolver(spec) <- "solveRglpk" message("setSolver: solveRglpk") } # Return Value: spec } # ------------------------------------------------------------------------------ "setOptimize<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the portfolio type for a portfolio structure # Arguments: # FUNCTION: # Type ? spec@model$optimize <- value # Return Value: spec } # ------------------------------------------------------------------------------ "setEstimator<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the type of mean-cov estimator for a portfolio structure # Arguments: # FUNCTION: # Estimator ? spec@model$estimator <- value # Return Value: spec } # ------------------------------------------------------------------------------ "setParams<-" <- function(spec, name, value) { # A function implemented by Diethelm Wuertz # Description: # Sets optional parameters for a portfolio structure # Arguments: # FUNCTION: # Extend Parameter List: spec@model$params[name] <- value # Return Value: spec } ################################################################################ "setWeights<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the weights vector for a portfolio structure # Arguments: # FUNCTION: # Weights ? spec@portfolio$weights <- value spec@portfolio$targetReturn <- NA spec@portfolio$targetRisk <- NA # Return Value: spec } # ------------------------------------------------------------------------------ "setTargetReturn<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the target return value for a portfolio structure # Arguments: # FUNCTION: # Target Return ? spec@portfolio$targetReturn <- value spec@portfolio$weights <- NA spec@portfolio$targetRisk <- NA # What to optimize ? spec@model$optimize <- "minRisk" # Return Value: spec } # ------------------------------------------------------------------------------ "setTargetRisk<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the target return value for a portfolio structure # Arguments: # FUNCTION: # Target Risk ? spec@portfolio$targetRisk <- value spec@portfolio$weights <- NA spec@portfolio$targetReturn <- NA # What to optimize ? spec@model$optimize <- "maxReturn" # Return Value: spec } # ------------------------------------------------------------------------------ "setAlpha<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the CVaR alpha significance value for a portfolio structure # Arguments: # FUNCTION: # Estimator ? spec@model$params$alpha <- value # Return Value: spec } # ------------------------------------------------------------------------------ "setRiskFreeRate<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the risk free rate for a portfolio structure # Arguments: # FUNCTION: # Check Validity: stopifnot(is.numeric(value)) stopifnot(length(value) == 1) # Risk-Free Rate ? spec@portfolio$riskFreeRate <- value # Return Value: spec } # ------------------------------------------------------------------------------ "setNFrontierPoints<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the number of frontier points for a portfolio structure # Arguments: # FUNCTION: # Check Validity: stopifnot(is.numeric(value)) stopifnot(length(value) == 1) stopifnot(value > 0) # Risk-Free Rate ? spec@portfolio$nFrontierPoints <- value # Return Value: spec } # ------------------------------------------------------------------------------ "setStatus<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets portfolio status information # Arguments: # FUNCTION: # Check Validity: stopifnot(is.numeric(value)) stopifnot(length(value) == 1) # Risk-Free Rate ? spec@portfolio$status <- value # Return Value: spec } # ------------------------------------------------------------------------------ "setTailRisk<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the tail risk value for a portfolio structure # Arguments: # value - a list with two matrix elements, $lower and $upper, # with the pairwise tail dependence coefficints. # Example: # LPP = as.timeSeries(data(LPP2005REC))[, 1:6] # setTailRisk <- .nigDependencyFit(LPP) # Arguments: # FUNCTION: # Tail Risk ? spec@model$tailRisk <- value # Return Value: spec } ################################################################################ "setSolver<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the solver value for a portfolio structure # Arguments: # FUNCTION: # Set Solver: spec@optim$solver <- value # Return Value: spec } # ------------------------------------------------------------------------------ "setObjective<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the solver objective function name for a portfolio structure # Arguments: # FUNCTION: # Set Solver: spec@optim$objective <- value # Return Value: spec } # ------------------------------------------------------------------------------ "setTrace<-" <- function(spec, value) { # A function implemented by Diethelm Wuertz # Description: # Sets the trace value for a portfolio structure # Arguments: # FUNCTION: # Set Trace: spec@optim$trace <- value # Return Value: spec } ################################################################################ fPortfolio/R/plot-weightsLines.R0000644000175100001440000003464612323217770016401 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # weightsLinePlot Plots staggered weights # weightedReturnsLinePlot Plots staggered weighted returns # covRiskBudgetsLinePlot Plots covariance risk budgets ################################################################################ weightsLinePlot <- function(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots a bar chart of weights # Arguments: # object - an object of class 'fPORTFOLIO' # labels - should the graph be automatically labeled? # col - a color palette, by default the rainbow palette # title - should the graph get default title and labels? # legend - should a legend be added to the plot? # FUNCTION: # Use default color if not specified ... Title = "Weights" if (is.null(col)) col = seqPalette(getNAssets(object)+1, "Blues")[-1] if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7 # Compute Weights: X = weights = getWeights(object) # Define Plot Range: ymax = max(colMaxs(weights)) ymin = min(colMins(weights)) range = ymax - ymin ymax = ymax + 0.005 * range ymin = ymin - 0.005 * range dim = dim(weights) range = dim[1] xmin = 0 xmax = range + 0.2 * range # Create Bar Plots: if (labels) { if(legend){ ts.plot(X, gpars = list(col = col, ann = FALSE, xaxt = "n"), xlim = c(xmin, xmax), ylim = c(ymin, ymax)) legendtext = names(getStatistics(object)$mu) if(is.null(legendtext)){ for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")} } legend("topright", legend = legendtext, bty = "n", cex = CEX, fill = col) } else { ts.plot(weights, gpars = list(col = col, ann = FALSE, xaxt = "n")) } } else { ts.plot(X, ...) } # Add Tailored Labels - 6 may be a good Number ... targetRisk = getTargetRisk(object)[, 1] targetReturn = getTargetReturn(object)[, 1] nSigma = length(targetRisk) nLabels = 6 M = c(0, ( 1:(nSigma %/% nLabels) ) ) *nLabels + 1 nSignifDigits = 3 axis(3, at = M, labels = signif(targetRisk[M], nSignifDigits)) axis(1, at = M, labels = signif(targetReturn[M], nSignifDigits)) # Add Axis Labels and Title: if (title) { mtext("Target Risk", side = 3, line = 2, adj = 1, cex = CEX) mtext("Target Return", side = 1, line = 2, adj = 1, cex = CEX) mtext("Weight", side = 2, line = 2, adj = 1, cex = CEX) } # Add Weights 0 and 1 Reference Lines # lines(x = c(0, nSigma), c(1, 1), col = "grey", lty = 3) # lines(x = c(0, nSigma), c(0, 0), col = "grey", lty = 3) # Add vertical Line at minimum risk: minIndex = which.min(targetRisk) minRisk = signif(min(targetRisk), 3) abline(v = minIndex, col = "black", lty = 1, lwd = 2) # Add Info: if (title) { mtext(paste(getType(object), "|", getSolver(object), "|", "minRisk =", minRisk), side = 4, adj = 0, col = "grey", cex = 0.7) } # Add Title: if (title) { mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1) } # Complete to draw box ... if (box) box() # Return Value: invisible() } # ------------------------------------------------------------------------------ weightedReturnsLinePlot <- function(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots a bar chart of weights # Arguments: # object - an object of class 'fPORTFOLIO' # labels - should the graph be automatically labeled? # col - a color palette, by default the rainbow palette # title - should the graph get default title and labels? # legend - should a legend be added to the plot? # FUNCTION: # Use default color if not specified ... Title = "Weighted Returns" if (is.null(col)) col = seqPalette(getNAssets(object)+1, "Blues")[-1] if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7 # Compute Weighted Returns: weights = getWeights(object) dim = dim(weights) returns = getStatistics(object)$mu weightedReturns = NULL for(i in 1:dim[2]){ nextWeightedReturns = weights[,i]*returns[i] weightedReturns = cbind(weightedReturns, nextWeightedReturns) } colnames(weightedReturns) = colnames(weights) X = weightedReturns # Define Plot Range: ymax = max(colMaxs(X)) ymin = min(colMins(X)) range = ymax - ymin ymax = ymax + 0.005 * range ymin = ymin - 0.005 * range dim = dim(weights) range = dim[1] xmin = 0 xmax = range + 0.2 * range # Create Bar Plots: if (labels) { if(legend){ ts.plot(X, gpars = list(col = col, ann = FALSE, xaxt = "n"), xlim = c(xmin, xmax), ylim = c(ymin, ymax)) legendtext = names(getStatistics(object)$mu) if(is.null(legendtext)){ for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")} } legend("topright", legend = legendtext, bty = "n", cex = CEX, fill = col) } else { ts.plot(weights, gpars = list(col = col, ann = FALSE, xaxt = "n")) } } else { ts.plot(X, ...) } # Add Tailored Labels - 6 may be a good Number ... targetRisk = getTargetRisk(object)[, 1] targetReturn = getTargetReturn(object)[, 1] nSigma = length(targetRisk) nLabels = 6 M = c(0, ( 1:(nSigma %/% nLabels) ) ) *nLabels + 1 nSignifDigits = 3 axis(3, at = M, labels = signif(targetRisk[M], nSignifDigits)) axis(1, at = M, labels = signif(targetReturn[M], nSignifDigits)) # Add Axis Labels and Title: if (title) { mtext("Target Risk", side = 3, line = 2, adj = 1, cex = CEX) mtext("Target Return", side = 1, line = 2, adj = 1, cex = CEX) mtext("Weight", side = 2, line = 2, adj = 1, cex = CEX) } # Add Weights 0 and 1 Reference Lines # lines(x = c(0, nSigma), c(1, 1), col = "grey", lty = 3) # lines(x = c(0, nSigma), c(0, 0), col = "grey", lty = 3) # Add vertical Line at minimum risk: minIndex = which.min(targetRisk) minRisk = signif(min(targetRisk), 3) abline(v = minIndex, col = "black", lty = 1, lwd = 2) # Add Info: if (title) { mtext(paste(getType(object), "|", getSolver(object), "|", "minRisk =", minRisk), side = 4, adj = 0, col = "grey", cex = 0.7) } # Add Title: if (title) { mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1) } # Complete to draw box ... if (box) box() # Return Value: invisible() } # ------------------------------------------------------------------------------ covRiskBudgetsLinePlot <- function(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots a bar chart of weights # Arguments: # object - an object of class 'fPORTFOLIO' # labels - should the graph be automatically labeled? # col - a color palette, by default the rainbow palette # title - should the graph get default title and labels? # legend - should a legend be added to the plot? # FUNCTION: # Use default color if not specified ... Title = "Covariance Risk Budgets" if (is.null(col)) col = seqPalette(getNAssets(object)+1, "Blues")[-1] if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7 # Compute Covariance Risk Budgets: X = getCovRiskBudgets(object) # Define Plot Range: ymax = max(colMaxs(X)) ymin = min(colMins(X)) range = ymax - ymin ymax = ymax + 0.005 * range ymin = ymin - 0.005 * range dim = dim(X) range = dim[1] xmin = 0 xmax = range + 0.2 * range # Create Bar Plots: if (labels) { if(legend){ ts.plot(X, gpars = list(col = col, ann = FALSE, xaxt = "n"), xlim = c(xmin, xmax), ylim = c(ymin, ymax)) legendtext = names(getStatistics(object)$mu) if(is.null(legendtext)){ for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")} } legend("topright", legend = legendtext, bty = "n", cex = CEX, fill = col) } else { ts.plot(weights, gpars = list(col = col, ann = FALSE, xaxt = "n")) } } else { ts.plot(X, ...) } # Add Tailored Labels - 6 may be a good Number ... targetRisk = getTargetRisk(object) targetReturn = getTargetReturn(object) nSigma = length(targetRisk) nLabels = 6 M = c(0, ( 1:(nSigma %/% nLabels) ) ) *nLabels + 1 nSignifDigits = 3 axis(3, at = M, labels = signif(targetRisk[M], nSignifDigits)) axis(1, at = M, labels = signif(targetReturn[M], nSignifDigits)) # Add Axis Labels and Title: if (title) { mtext("Target Risk", side = 3, line = 2, adj = 1, cex = CEX) mtext("Target Return", side = 1, line = 2, adj = 1, cex = CEX) mtext("Weight", side = 2, line = 2, adj = 1, cex = CEX) } # Add Weights 0 and 1 Reference Lines # lines(x = c(0, nSigma), c(1, 1), col = "grey", lty = 3) # lines(x = c(0, nSigma), c(0, 0), col = "grey", lty = 3) # Add vertical Line at minimum risk: minIndex = which.min(targetRisk[, 1]) minRisk = signif(min(targetRisk[, 1]), 3) abline(v = minIndex, col = "black", lty = 1, lwd = 2) # Add Info: if (title) { mtext(paste(getType(object), "|", getSolver(object), "|", "minRisk =", minRisk), side = 4, adj = 0, col = "grey", cex = 0.7) } # Add Title: if (title) { mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1) } # Complete to draw box ... if (box) box() # Return Value: invisible() } # ------------------------------------------------------------------------------ .tailRiskBudgetsLinePlot <- function(object, labels = TRUE, col = NULL, title = TRUE, box = TRUE, legend = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots a bar chart of weights # Arguments: # object - an object of class 'fPORTFOLIO' # labels - should the graph be automatically labeled? # col - a color palette, by default the rainbow palette # title - should the graph get default title and labels? # legend - should a legend be added to the plot? # FUNCTION: # Use default color if not specified ... Title = "Covariance Risk Budgets" if (is.null(col)) col = seqPalette(getNAssets(object)+1, "Blues")[-1] if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7 # Compute Covariance Risk Budgets: stop("Not yet implemented") tailRiskMatrix = getTailRisk(object) X = getTailRiskBudgets(object) # Define Plot Range: ymax = max(colMaxs(X)) ymin = min(colMins(X)) range = ymax - ymin ymax = ymax + 0.005 * range ymin = ymin - 0.005 * range dim = dim(weights) range = dim[1] xmin = 0 xmax = range + 0.2 * range # Create Bar Plots: if (labels) { if(legend){ ts.plot(X, gpars = list(col = col, ann = FALSE, xaxt = "n"), xlim = c(xmin, xmax), ylim = c(ymin, ymax)) legendtext = names(getStatistics(object)$mu) if(is.null(legendtext)){ for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")} } legend("topright", legend = legendtext, bty = "n", cex = CEX, fill = col) } else { ts.plot(weights, gpars = list(col = col, ann = FALSE, xaxt = "n")) } } else { ts.plot(X, ...) } # Add Tailored Labels - 6 may be a good Number ... targetRisk = getTargetRisk(object) targetReturn = getTargetReturn(object) nSigma = length(targetRisk) nLabels = 6 M = c(0, ( 1:(nSigma %/% nLabels) ) ) *nLabels + 1 nSignifDigits = 3 axis(3, at = M, labels = signif(targetRisk[M], nSignifDigits)) axis(1, at = M, labels = signif(targetReturn[M], nSignifDigits)) # Add Axis Labels and Title: if (title) { mtext("Target Risk", side = 3, line = 2, adj = 1, cex = CEX) mtext("Target Return", side = 1, line = 2, adj = 1, cex = CEX) mtext("Weight", side = 2, line = 2, adj = 1, cex = CEX) } # Add Weights 0 and 1 Reference Lines # lines(x = c(0, nSigma), c(1, 1), col = "grey", lty = 3) # lines(x = c(0, nSigma), c(0, 0), col = "grey", lty = 3) # Add vertical Line at minimum risk: minIndex = which.min(targetRisk[, 1]) minRisk = signif(min(targetRisk[, 1]), 3) abline(v = minIndex, col = "black", lty = 1, lwd = 2) # Add Info: if (title) { mtext(paste(getType(object), "|", getSolver(object), "|", "minRisk =", minRisk), side = 4, adj = 0, col = "grey", cex = 0.7) } # Add Title: if (title) { mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1) } # Complete to draw box ... if (box) box() # Return Value: invisible() } ################################################################################ fPortfolio/R/solve-RtwoAssets.R0000644000175100001440000001217512323217770016215 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # .solveRtwoAssets Two Assets LongOnly MV Portfolio # .cvarSolveTwoAssets Two Assets LongOnly CVaR Portfolio # .madSolveTwoAssets Two Assets LongOnly MAD Portfolio ################################################################################ .solveRtwoAssets <- function(data, spec, constraints) { # Description: # Two Assets LongOnly MV Portfolio # Details: # ... this is only thohgt for 'unlimited' LongOnly # box and group constraints are discarded here. # FUNCTION: # Solver: # print(".mvSolveTwoAssets") # Convert Data and Constraints to S4 Objects: Data = portfolioData(data, spec) data <- getSeries(Data) Constraints = portfolioConstraints(Data, spec, constraints) # Stop if the Target Return is not Defined! targetReturn = getTargetReturn(spec) stopifnot(is.numeric(targetReturn)) # Optimize Portfolio: nAssets = getNAssets(Data) # Solve the two Assets Case Analytically: mu <- getMu(Data) Sigma <- getSigma(Data) stopifnot(targetReturn >= min(mu)) stopifnot(targetReturn <= max(mu)) weights <- (targetReturn-mu[2]) / (mu[1]-mu[2]) weights <- c(weights, 1 - weights) # Output List: ans = list( solver = "MVTwoAssets", optim = NA, weights = weights, targetReturn = targetReturn, targetRisk = NA, objective = sqrt(weights %*% Sigma %*% weights), status = 0, message = NA) # Return Value: ans } # ------------------------------------------------------------------------------ .cvarSolveTwoAssets <- function(data, spec, constraints) { # Description: # Two Assets LongOnly CVaR Portfolio # Details: # ... this is only thohgt for 'unlimited' LongOnly # box and group constraints are discarded here. # FUNCTION: # Solver: # print(".cvarSolveTwoAssets") # Convert Data and Constraints to S4 Objects: Data <- portfolioData(data, spec) data <- getSeries(Data) Constraints = portfolioConstraints(Data, spec, constraints) # Stop if the Target Return is not Defined! targetReturn = getTargetReturn(spec) stopifnot(is.numeric(targetReturn)) targetAlpha = getAlpha(spec) # Optimize Portfolio: nAssets <- getNAssets(Data) # Solve the two Assets Case Analytically: mu <- getMu(Data) stopifnot(targetReturn >= min(mu)) stopifnot(targetReturn <= max(mu)) weights <- (targetReturn-mu[2]) / (mu[1]-mu[2]) weights <- c(weights, 1 - weights) optim <- list( VaR = .varRisk(data, weights, targetAlpha), CVaR = -.cvarRisk(data, weights, targetAlpha), targetAlpha = targetAlpha) ans <- list( solver = "CVaRTwoAssets", optim = optim, weights = weights, targetReturn = targetReturn, targetRisk = NA, objective = optim$CVaR, status = 0, message = NA) # Return Value: ans } # ------------------------------------------------------------------------------ .madSolveTwoAssets <- function(data, spec, constraints) { # Description: # Two Assets LongOnly MAD Portfolio # Details: # ... this is only thohgt for 'unlimited' LongOnly # box and group constraints are discarded here. # FUNCTION: # Convert Data and Constraints to S4 Objects: Data = portfolioData(data, spec) data <- getSeries(Data) Constraints <- portfolioConstraints(Data, spec, constraints) # Stop if the Target Return is not Defined! targetReturn <- getTargetReturn(spec) stopifnot(is.numeric(targetReturn)) # Optimize Portfolio: nAssets <- getNAssets(Data) # Solve the two Assets Case Analytically: mu = getMu(Data) stopifnot(targetReturn >= min(mu)) stopifnot(targetReturn <= max(mu)) weights = (targetReturn-mu[2]) / (mu[1]-mu[2]) weights = c(weights, 1 - weights) targetRisk = mean( abs( (data - colMeans(data)) %*% weights ) ) # Output List: ans = list( solver = "MADTwoAssets", optim = NA, weights = weights, targetReturn = targetReturn, targetRisk = targetRisk, objective = targetRisk, status = 0, message = NA) # Return Value: ans } ################################################################################ fPortfolio/R/a-class-fPFOLIOVAL.R0000644000175100001440000000223112323217770015763 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # 'fPFOLIOVAL' S4 Portfolio Values Class ################################################################################ setClass("fPFOLIOVAL", representation( portfolio = "list", messages = "list") ) ################################################################################ fPortfolio/R/mathprogNLP.R0000644000175100001440000000442213202336220015125 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # .solveNLP.demo Mean-variance portfolio demo solved by NLP ################################################################################ .solveNLP.demo <- function() { # Solve Mean-Variance Portfolio: # Load Dataset dataSet <- data("LPP2005REC", package="timeSeries", envir=environment()) LPP2005REC <- get(dataSet, envir=environment()) # Load Swiss Pension Fund Data: nAssets <- 6 data <- 100 * LPP2005REC[, 1:nAssets] mu <- colMeans(data) Sigma <- cov(data) # Arguments: start <- rep(1, nAssets)/nAssets objective <- function(x) { 0.5 * (x %*% Sigma %*% x)[[1]] } lower <- rep(0, nAssets) upper <- rep(1, nAssets) mat <- rbind( budget = rep(1, times=nAssets), returns = colMeans(data)) matLower <- c( budget = 1, return = mean(data)) matUpper <- matLower linCons <- list(mat, matLower, matUpper) control <- list() # donlp2 Solver: # require(Rdonlp2) ans <- rdonlp2NLP(start, objective, lower, upper, linCons) ans # solnp Solver: # require(Rsolnp) ans <- rsolnpNLP(start, objective, lower, upper, linCons) ans # nlminb2 Solver: # require(Rnlminb2) ans <- rnlminb2NLP(start, objective, lower, upper, linCons) ans } ################################################################################ fPortfolio/R/risk-pfolioMeasures.R0000644000175100001440000002073612323217770016716 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # covRisk Computes covariance risk as standard deviation # varRisk Computes Value at Risk # cvarRisk Computes Conditional Value at Risk # FUNCTION: DESCRIPTION - DEPRECATED: # .covRisk Computes Covariance Risk # .varRisk Computes Value at Risk # .cvarRisk Computes Conditional Value at Risk # FUNCTION: DESCRIPTION: # .cfgFit Fits bivariate tail dependency parameter lambda # .lambdaTailRisk Fits tail lambda for multivariate data ################################################################################ covRisk <- function(data, weights) { # A function implemented by Diethelm Wuertz # Description: # Computes Covariance Risk for assets given weights # Arguments: # data - any univariate or multivariate object which can # be transformed into a matrix # weights - a numeric vector, the weights vector # Example: # data = LPP2005.RET[, 1:6]; weights = rep(1/6, times = 6) # covRisk(data, weights) # FUNCTION: # Data: if (inherits(data, "timeSeries")) data <- getDataPart(data) Data <- as.matrix(data) nAssets = dim(Data)[2] # Covariance Matrix: Sigma = cov(Data) # Risk: weights = as.vector(weights) Std = sqrt( as.numeric( weights %*% Sigma %*% weights ) ) names(Std) = "Cov" # Return Value: Std } # ------------------------------------------------------------------------------ varRisk <- function(data, weights, alpha = 0.05) { # A function implemented by Diethelm Wuertz # Description: # Computes VaR for assets given weights and alpha # Arguments: # data - any univariate or multivariate object which can # be transformed into a matrix # weights - a numeric vector, the weights vector # alpha - a numeric value, the quantile # Example: # data = LPP2005.RET[, 1:6]; weights = rep(1/6, times = 6) # varRisk(data, weights) # FUNCTION: if (inherits(data, "timeSeries")) data <- getDataPart(data) # VaR: weights = as.vector(weights) X = as.matrix(data) %*% weights VaR = quantile(X, alpha, type = 1) names(VaR) <- paste("VaR.", alpha*100, "%", sep = "") # Return Value: VaR } # ------------------------------------------------------------------------------ cvarRisk <- function(data, weights, alpha = 0.05) { # A function implemented by Diethelm Wuertz # Description: # Computes CVaR for assets given weights and alpha # Arguments: # data - any univariate or multivariate object which can # be transformed into a matrix # weights - a numeric vector, the weights vector # alpha - a numeric value, the quantile # Example: # data = LPP2005.RET[, 1:6]; weights = rep(1/6, times = 6) # cvarRisk(data, weights) # FUNCTION: if (inherits(data, "timeSeries")) data <- getDataPart(data) # CVaR: weights = as.vector(weights) X = as.matrix(data) %*% weights VaR = quantile(X, alpha, type = 1) CVaR = c(CVaR = VaR - 0.5 * mean(((VaR-X) + abs(VaR-X))) / alpha) names(CVaR) <- paste("CVaR.", alpha*100, "%", sep = "") # Return Value: CVaR } ################################################################################ # OLD FUNCTIONS: # check where they are still used .covRisk <- function(data, weights) { # A function implemented by Rmetrics # Description: # Computes Covariance Risk for assets given weights and alpha # FUNCTION: if (inherits(data, "timeSeries")) data <- getDataPart(data) # Data: Data = as.matrix(data) nAssets = dim(Data)[2] # Mean Vector and Covariance: mu = colMeans(Data) Sigma = cov(Data) # Return and Risk: return = as.numeric( weights %*% mu ) risk = sqrt( as.numeric( weights %*% Sigma %*% weights ) ) # Return Value: list(risk = risk, return = return) } # ------------------------------------------------------------------------------ .varRisk <- function(x, weights, alpha = 0.05) { # A function implemented by Rmetrics # Description: # Computes VaR for assets given weights and alpha # Arguments: # x - any univariate or multivariate object which can # be transformed into a matrix # weights - a numeric vector, the weights vector # alpha - a numeric value, the quantile # FUNCTION: if (inherits(x, "timeSeries")) x <- getDataPart(x) # VaR: X = as.matrix(x) %*% weights VaR = quantile(X, alpha, type = 1) names(VaR) <- paste("VaR.", alpha*100, "%", sep = "") # Return Value: VaR } # ------------------------------------------------------------------------------ .cvarRisk <- function(x, weights, alpha = 0.05) { # A function implemented by Rmetrics # Description: # Computes CVaR for assets given weights and alpha # Arguments: # x - any univariate or multivariate object which can # be transformed into a matrix # weights - a numeric vector, the weights vector # alpha - a numeric value, the quantile # FUNCTION: if (inherits(x, "timeSeries")) x <- getDataPart(x) # CVaR: X = as.matrix(x) %*% weights VaR = quantile(X, alpha, type = 1) CVaR = c(CVaR = VaR - 0.5 * mean(((VaR-X) + abs(VaR-X))) / alpha) names(CVaR) <- paste("CVaR.", alpha*100, "%", sep = "") # Return Value: CVaR } ################################################################################ .cfgFit <- function(x, y, tail = c("upper", "lower")) { # Description: # Fits bivariate tail dependency parameter lambda # Arguments: # data - multivariate time series object of class S4 or a numeric # matrix # tail - which tail should be considered? # FUNCTION: # Match Arguments: tail = match.arg(tail) # If Lower Tail: if(tail == "lower") { x = 1-x y = 1-y } # Fit lambda: lambda = NULL n = length(x) for(i in 1:n){ lambda = c(lambda, log(sqrt(log(1/x[i])*log(1/y[i]))/log(1/max(x[i],y[i])^2))) } ans = (2-2*exp(sum(lambda/n))) attr(ans, "control") <- c(tail = tail) # Return Value: ans } # ------------------------------------------------------------------------------ .lambdaTailRisk <- function(data, tail = c("upper", "lower"), margins = "norm", ...) { # Description: # Fits tail dependency parameter lambda for multivariate data # Arguments: # data - multivariate time series object of class S4 or a numeric # matrix # tail - which tail should be considered? # Example: # r = rarchmCopula(60, alpha = 2, type = "4") # .cfgFit(r[, 1], r[, 2]) # x = cbind(qnorm(r[, 1]), qnorm(r[, 2])) # .lambdaTailRisk(x) # FUNCTION: # Check Data: if(is.timeSeries(data)) data = series(data) n = ncol(data) # Normal Margins - Create Bivariate Copulae: x = data for (i in 1:n) { y = as.vector(data[, i]) x[, i] = pnorm(y, mean(y), sd(y)) } # Match Arguments: tail = match.arg(tail) # Compute Tail Risks: riskMatrix = diag(n) # Compute lambda: for ( i in 1:(n-1) ) { for ( j in (i+1):n ) { riskMatrix[i, j] = riskMatrix[j, i] = .cfgFit(x[, i], x[, j], tail = tail) } } attr(riskMatrix, "control") <- c(tail = tail) # Return Value: riskMatrix } ################################################################################ fPortfolio/R/solve-environment.R0000644000175100001440000000344412323217770016442 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # GLOBAL SETTINGS: DESCRIPTION: # Data Defines global portfolio Data object # portfolioObjective Defines global portfolio objective function # portfolioReturn Defines global portfolio return function # portfolioRisk Defines global portfolio risk function ############################################################################### # Global Variables, do it properly ... # ----------------------------------------------------------------------------- Data <- NA # ----------------------------------------------------------------------------- portfolioObjective <- function(weights) { NA } # ----------------------------------------------------------------------------- portfolioReturn <- function(weights) { NA } # ----------------------------------------------------------------------------- portfolioRisk <- function(weights) { NA } ############################################################################### fPortfolio/R/portfolio-riskPfolio.R0000644000175100001440000002611612620132672017102 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # pfolioVaR Computes VaR for a portfolio of assets # pfolioCVaR Computes CVaR for a portfoluio of assets # pfolioCVaRplus Computes CVaR-Plus for a portfolio of assets # lambdaCVaR Computes CVaR's atomic split value lambda # pfolioCVaRoptim Computes CVaR from mean-CVaR portfolio optimization # FUNCTION: DESCRIPTION: # pfolioMaxLoss Computes maximum loss for a portfolio # pfolioReturn Computes return series for a portfolio # pfolioTargetReturn Computes target return for a portfolio # pfolioTargetRisk Computes target risk for a portfolio # pfolioHist Plots a histogram of portfolio returns ################################################################################ pfolioVaR <- function(x, weights = NULL, alpha = 0.05) { # A function implemented by Diethelm Wuertz # Description: # Compute Value-at-Risk for a portfolio of assets # Arguments: # x - a time series, data.frame or any other rectangular object # of assets which can be written as a matrix object # weights - a numeric vector of weights # alpha - the confidence level # FUNCTION: # Transform: x <- as.matrix(x) # Compute Portfolio VaR: if (is.null(weights)) weights <- rep(1/dim(x)[[2]], dim(x)[[2]]) n <- dim(x)[1] x <- apply(t(t(x) * weights), 1, sum) n.alpha <- max(floor(n * alpha)) ans <- as.vector(sort(x)[n.alpha]) names(ans) <- "VaR" # Return Value: ans } # ------------------------------------------------------------------------------ pfolioCVaRplus <- function(x, weights = NULL, alpha = 0.05) { # A function implemented by Diethelm Wuertz # Description: # Compute Value-at-Risk Plus for a portfolio of assets # Arguments: # x - a time series, data.frame or any other rectangular object # of assets which can be written as a matrix object # weights - a numeric vector of weights # alpha - the confidence level # FUNCTION: # Transform: x <- as.matrix(x) # Compute Portfolio CVaRplus: if (is.null(weights)) weights = rep(1/dim(x)[[2]], dim(x)[[2]]) n <- dim(x)[1] x <- apply(t(t(x) * weights), 1, sum) n.alpha <- max(1, floor(n * alpha)-1) ans <- as.vector(mean(sort(x)[1:n.alpha])) names(ans) <- "CVaRplus" # Return Value: ans } # ------------------------------------------------------------------------------ pfolioCVaR <- function(x, weights = NULL, alpha = 0.05) { # A function implemented by Diethelm Wuertz # Description: # Compute Conditional Value-at-risk for a portfolio of assets # Arguments: # x - a time series, data.frame or any other rectangular object # of assets which can be written as a matrix object # weights - a numeric vector of weights # alpha - the confidence level # lambda - split value # FUNCTION: # Transform: data <- as.matrix(x) # Input Data: if (is.null(weights)) weights = rep(1/dim(data)[[2]], dim(data)[[2]]) n <- dim(data)[1] Rp <- apply(t(t(data)*weights), 1, sum) # Sort the Portfolio returns Y sorted <- sort(Rp) # Compute Portfolio VaR: n.alpha <- floor(n*alpha) VaR <- sorted[n.alpha] # Compute Portfolio CVaRplus: n.alpha <- max(1, floor(n*alpha)-1) CVaRplus <- mean(sorted[1:n.alpha]) # Compute Portfolio CVaR: lambda <- 1 - floor(n*alpha)/(n*alpha) ans <- as.vector(lambda*VaR + (1-lambda)*CVaRplus) names(ans) <- "CVaR" attr(ans, "control") = c(CVaRplus = CVaRplus, lambda = lambda) # Return Value: ans } # ------------------------------------------------------------------------------ lambdaCVaR <- function(n, alpha = 0.05) { # A function implemented by Diethelm Wuertz # Description: # Computes CVaR's atomic split value lambda # Arguments: # n - the number of oberservations # alpha - the confidence interval # FUNCTION: # Compute CVaR lambda: lambda <- 1 - floor(alpha * n) / (alpha * n) names(lambda) <- "lambda" # Return Value: lambda } # ------------------------------------------------------------------------------ pfolioCVaRoptim <- function(x, weights = NULL, alpha=0.05) { # A function implemented by Diethelm Wuertz # Description: # Compute Conditional Value-at-risk by mean-CVaR portfolio Optimization # Arguments: # x - a time series, data.frame or any other rectangular object # of assets which can be written as a matrix object # weights - a numeric vector of weights # alpha - the confidence level # FUNCTION: # Transform: data <- as.matrix(x) if (is.null(weights)) weights <- rep(1/dim(data)[[2]], dim(data)[[2]]) Rp <- apply(t(t(data) * weights), 1, sum) .f <- function(VaR, data, weights, alpha) { S <- nrow(data) X <- apply(t(t(data) * weights), 1, sum) -VaR CVaR <- VaR + sum((X - abs(X))/2) / S / alpha CVaR } # Compute optimized CVaR: ans <- optimize(.f, interval=range(Rp), tol=.Machine$double.eps, maximum=TRUE, data=data, weights=weights, alpha=alpha) ans <- ans$objective names(ans) <- "CVaRoptim" # Return Value: ans } ################################################################################ pfolioMaxLoss <- function(x, weights = NULL) { # A function implemented by Diethelm Wuertz # Description: # Computes maximum loss for a portfolio of assets # Arguments: # x - a timeSeries, data.frame or any other rectangular object # of assets which can be written as a matrix object # weights - the vector of weights # alpha - the confidence level # FUNCTION: # Transform: x <- as.matrix(x) # Compute MaxLoss [MinReturn]: if (is.null(weights)) { weights = rep(1/dim(x)[[2]], dim(x)[[2]]) } x = apply(t(t(x)*weights), 1, sum) ans = min(x) # Return Value: ans } # ------------------------------------------------------------------------------ pfolioReturn <- function(x, weights=NULL, geometric=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns portfolio returns # Arguments: # x - a 'timeSeries' object # Details: # A fast(er) reimplementation # FUNCTION: # Compute Portfolio Returns: weights <- as.vector(weights) if(geometric) { X <- t ( colCumprods(1+x) - 1 ) X <- rbind(diff( t ( X * weights ) )) Return <- x[, 1] series(Return[+1, ]) <- x[1, ] %*% weights series(Return[-1, ]) <- rowSums(X) } else { Return <- x[, 1] series(Return) <- x %*% weights } colnames(Return) <- "pfolioRet" # Return Value: Return } # ------------------------------------------------------------------------------ pfolioTargetReturn <- function(x, weights = NULL) { # A function implemented by Diethelm Wuertz # Description: # Computes return value of a portfolio # Arguments: # x - a timeSeries, data.frame or any other rectangular object # of assets which can be written as a matrix object # weights - the vector of weights # FUNCTION: # Transform: x <- as.matrix(x) # Compute Portfolio Returns: ans = mean(pfolioReturn(x = x, weights = weights)) # Return Value: names(ans) = "TargetReturn" ans } # ------------------------------------------------------------------------------ pfolioTargetRisk <- function(x, weights = NULL) { # A function implemented by Diethelm Wuertz # Description: # Computes risk from covariance matrix of a portfolio # Arguments: # x - a timeSeries, data.frame or any other rectangular object # of assets which can be written as a matrix object # weights - the vector of weights # FUNCTION: # Transform: x <- as.matrix(x) # Compute Portfolio Returns: if (is.null(weights)) weights = rep(1/dim(x)[[2]], dim(x)[[2]]) ans = as.vector(sqrt(weights %*% cov(x) %*% weights)) # Return Value: names(ans) = "TargetRisk" ans } # ------------------------------------------------------------------------------ pfolioHist <- function(x, weights = NULL, alpha = 0.05, range = NULL, details = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots a histogram of the returns of a portfolio # Arguments: # x - a timeSeries, data.frame or any other rectangular object # of assets which can be written as a matrix object # weights - the vector of weights # FUNCTION: # Transform: x <- as.matrix(x) # Suppress Warnings: opt = options() options(warn = -1) # Plot Portfolio Returns: Returns = pfolioReturn(x = x, weights = weights) if (is.null(range)) { lim = 1.05 * pfolioMaxLoss(x = x, weights = weights)[[1]] xlim = c(lim, -lim) } else { xlim = range } Histogram = hist(Returns, xlim = xlim, xlab = "Portfolio Return %", probability = TRUE, col = "steelblue4", border = "white", ...) r = seq(xlim[1], xlim[2], length = 201) lines(r, dnorm(r, mean = mean(Returns), sd = sd(Returns)), ...) points(Returns, rep(0, length(Returns)), pch = 20, col = "orange", cex = 1.25) # Add VaR, CVaRplus and MaxLoss: V1 = pfolioVaR(x = x, weights = weights, alpha = alpha)[[1]] abline(v = V1, col = "blue", ...) V2 = pfolioCVaRplus(x = x, weights = weights, alpha = alpha)[[1]] abline(v = V2, col = "red", ...) V3 = pfolioMaxLoss(x = x, weights = weights)[[1]] abline(v = V3, col = "green", ...) V4 = as.vector(mean(Returns))[[1]] V5 = as.vector(sd(Returns))[[1]] yt = max(density(Returns)$y) text(V1, yt, as.character(round(V1, 2)), cex = 0.75, col = "orange") text(V2, yt, as.character(round(V2, 2)), cex = 0.75, col = "orange") text(V3, yt, as.character(round(V3, 2)), cex = 0.75, col = "orange") text(V4, yt, as.character(round(V4, 2)), cex = 0.75, col = "orange") yt = 0.95 * yt text(V1, yt, "VaR", cex = 0.75, col = "orange") text(V2, yt, "CVaR+", cex = 0.75, col = "orange") text(V3, yt, "maxLoss", cex = 0.75, col = "orange") text(V4, yt, "Mean", cex = 0.75, col = "orange") # Result: options(opt) ans = list(VaR = V1, VaRplus = V2, maxLoss = V3, mean = V4, sd = V5) if (details) { cat("\nVaR: ", V1) cat("\nVaRplus: ", V2) cat("\nmax Loss: ", V3) cat("\nMean: ", V4) cat("\nStDev: ", V5) cat("\n") } # Return Value: invisible(ans) } ################################################################################ fPortfolio/R/plot-vaniniFig.R0000644000175100001440000000541512410245712015630 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # .vaniniFig Creates Vinini's Figure in Portfolio eBook ################################################################################ .vaniniFig <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: # Load Dataset dataSet <- data("LPP2005.RET", package="fPortfolio", envir=environment()) LPP2005.RET <- get(dataSet, envir=environment()) # Example Data: data = 100 * LPP2005.RET[, 1:6] mu = colMeans(data) Sigma = cov(data) one = rep(1, times = 6) # Short Selling Solution : invSigma = solve(Sigma) A = (mu %*% invSigma %*% one)[[1,1]] C = (one %*% invSigma %*% one)[[1,1]] B = (mu %*% invSigma %*% mu)[[1,1]] E = (one %*% invSigma %*% mu)[[1,1]] D = B*C - A*A # Minimum Variance Point: xMV = 1/sqrt(C) yMV = A/C # Frontier Points: x = seq(xMV, 4*xMV, length = 500) a = C b = -2 * A c = B - D * x^2 yp = (-b + sqrt(b^2 - 4 * a * c))/(2 * a) ym = (-b - sqrt(b^2 - 4 * a * c))/(2 * a) # Asymptotic Slopes: slope = sqrt(D/C) intercept = A/C # Tangency Line: x.tg = sqrt(B)/E y.tg = B/E slope.tg = y.tg/x.tg # Plot: plot(x, yp, type = "l", xlim = c(0, max(x)), ylim = c(-0.08, 0.08), axes = FALSE, xlab = "Covariance Risk", ylab = "Mean Retun") lines(x, ym) points(xMV, yMV, col = "orange", cex = 2, pch = 19) abline(intercept, slope, col = "blue", lty = 2) abline(intercept, -slope, col = "blue", lty = 2) abline(h = yMV, col = "grey", lty = 3) abline(v = 0, col = "grey", lty = 3) points(x.tg, y.tg, col = "red", cex = 2, pch = 19) abline(0, slope.tg, col = "brown", lty = 2) # Return Value: invisible() } ################################################################################ fPortfolio/R/utils-specs.R0000644000175100001440000000745012323217770015224 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA #################################################################################################### # FUNCTION: #################################################################################################### # Arguments: # start objective lower upper linCons funCons amplCons control ... # =0 =1 =list() # class() list() list() list() list() # # LP Solver # glpkLP default . numeric x x yes . . glpkLPControl . # symphonyLP . . numeric x x yes . . symphonyLPControl . # amplLP . . numeric x x yes . . amplLPControl . # # QP Solver # quadprogQP default . list x x yes . . quadprogQPControl . # ipoptQP . . list x x yes . . ipoptQPControl . # amplQP . . list x x yes . . amplQPControl . # # NLP Solver # solnpNLP default yes function x x yes yes . solnpNLPControl . # donlp2NLP . yes function x x yes yes . donlp2NLPControl . # nlminb2NLP . yes function x x yes yes . nlminb2NLPControl . # amplNLP . length character x x . . yes amplNLPControl yes # # AMPL Solver tested: ipopt, donlp2, mosek, ... #################################################################################################### # Value: # # value <- list( # call, control, dots, # opt, # solution, objective, status, message, solver, # class(value) <- c("solver", "list") #################################################################################################### # Methods: # print.solver <- function(x, ...) x # summary.solver <- function(x, ...) x # getSolution <- function(x) x$solution # getObjective <- function(x) x$objective # getStatus <- function(x) x$status # getMessage <- function(x) x$message #################################################################################################### fPortfolio/R/solve-Rsolnp.R0000644000175100001440000001531512323217770015353 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRsolnp Portfolio interface to solver Rsolnp # .rsolnpArguments Returns arguments for solver ################################################################################ solveRsolnp <- function(data, spec, constraints) { # Description: # Portfolio interface to solver Rsolnp # Arguments; # data - an object of class timeSeries # spec - an object of class fPFOLIOSPEC # constraints - an object of class character # FUNCTION: # Settings: Data <- portfolioData(data, spec) nAssets <- getNAssets(Data) mu <- getMu(Data) Sigma <- getSigma(Data) # Compose Arguments for Solver: args <- .rsolnpArguments(data, spec, constraints) optim <- Rsolnp::solnp( pars = args$par, fun = args$fun, grad = NULL, eqfun = args$eqfun, eqB = args$B, eqgrad = NULL, ineqfun = args$ineqfun, ineqLB = args$ineqLB, ineqUB = args$ineqUB, ineqgrad = NULL, LB = args$LB, UB = args$UB, control = list()) # Extract Weights: weights <- .checkWeights(optim$par) attr(weights, "invest") <- sum(weights) # Check Messages and Get Status: # ... unfortunately solnp has no status variable, # so we have to analyze the messages Status = 1 # Result: ans <- list( type = "MV", solver = "solveRsolnp", optim = optim, weights = weights, targetReturn = NA, targetRisk = NA, objective = optim$fx, status = Status, message = optim$message) returnFun <- match.fun(getObjective(spec)[2]) ans$targetReturn <- returnFun(ans$weights) riskFun <- match.fun(getObjective(spec)[3]) ans$targetRisk <- riskFun(ans$weights) # Return Value: ans } # ------------------------------------------------------------------------------ .rsolnpArguments <- function(data, spec, constraints) { # Description: # Create Arguments for Rsolnp # Details: # min: fun(x) # subject to: # g_i(x) = eqB # ineqLB <= h_i(x) <= ineqUB # LB <= x <= UB # FUNCTION: DEBUG = FALSE # Settings: Data <- portfolioData(data) nAssets <- getNAssets(Data) mu <- getMu(Data) Sigma <- getSigma(Data) fn <- match.fun(getObjective(spec)[1]) # Box Constrains: LB <- minWConstraints(data, spec, constraints) UB <- maxWConstraints(data, spec, constraints) if(DEBUG) print(rbind(LB, UB)) # Linear / Group Constraints: # ... targetReturn may be not defined,then set it to NA if (is.null(getTargetReturn(spec))) setTargetReturn(spec) <- NA # ... has in the first line the return constraint, if NA then ignore it eqsumW <- eqsumWConstraints(data, spec, constraints) if (is.na(eqsumW[1, 1])) eqsumW = eqsumW[-1, , drop= FALSE] Aeqsum <- eqsumW[, -1] aeqsum <- eqsumW[, 1] minsumW <- minsumWConstraints(data, spec, constraints) if (is.null(minsumW)) { Aminsum <- aminsum <- NULL } else { Aminsum <- minsumW[, -1] aminsum <- minsumW[, 1] } maxsumW = maxsumWConstraints(data, spec, constraints) if (is.null(maxsumW)) { Amaxsum <- amaxsum <- NULL } else { Amaxsum <- maxsumW[, -1] amaxsum <- maxsumW[, 1] } A <- rbind(Aeqsum, Aminsum, Amaxsum) lin.lower <- c(aeqsum, aminsum, rep(-Inf, length(amaxsum))) lin.upper <- c(aeqsum, rep(Inf, length(aminsum)), amaxsum) if(DEBUG) print(cbind(lin.lower, A, lin.upper)) # Nonlinear Constraints - Here Covariance Risk Budgets: nlin <- list() nlin.lower <- NULL nlin.upper <- NULL # Check Constraints Strings for Risk Budgets: # Example: constraints = c("minB[2:3]=0.1", "maxB[3:5]=0.9") validStrings <- c("minB", "maxB") usedStrings <- unique(sort(sub("\\[.*", "", constraints))) checkStrings <- sum(usedStrings %in% validStrings) includeRiskBudgeting <- as.logical(checkStrings) if (DEBUG) print(includeRiskBudgeting) if (includeRiskBudgeting) { # Compose Non-Linear (Cov Risk Budget) Constraints Functions: nlcon <- function(x) { B1 = as.vector(x %*% Sigma %*% x) B2 = as.vector(x * Sigma %*% x) B = B2/B1 B } if(DEBUG) print(nlcon) # Compose non-linear functions now for each asset ... for (I in 1:nAssets) eval( parse(text = paste( "nlcon", I, " = function(x) { nlcon(x)[", I, "] }", sep = "")) ) nlinFunctions = paste("nlcon", 1:nAssets, sep = "", collapse = ",") nlinFunctions = paste("list(", nlinFunctions, ")") nlin = eval( parse(text = nlinFunctions) ) if(DEBUG) print(nlin) # ... and finally Compose Constraints Vectors: nlin.lower = minBConstraints(data, spec, constraints) nlin.upper = maxBConstraints(data, spec, constraints) if(DEBUG) print(rbind(nlin.lower, nlin.upper)) } # General non-lin Portfolio Constraints: # ... todo: currently overwrites previous selection nlin = listFConstraints(data, spec, constraints) if(DEBUG) print(nlin) nlin.lower = minFConstraints(data, spec, constraints) nlin.upper = maxFConstraints(data, spec, constraints) if(DEBUG) print(cbind(nlin.lower, nlin.upper)) # Return Value: list( pars = rep(1/nAssets, nAssets), fun = fn, grad = NULL, eqfun = NULL, eqB = NULL, eqgrad = NULL, ineqfun = nlinFunctions, ineqLB = nlin.lower, ineqUB = nlin.upper, ineqgrad = NULL, LB = LB, UB = UB) } ################################################################################ fPortfolio/R/object-getSpec.R0000644000175100001440000001210212421220204015556 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # getModel Extract whole model slot # getType Extract portfolio type from specification # getOptimize Extract what to optimize from specification # getEstimator Extract type of covariance estimator # getTailRisk Extract list of tail dependency risk matrixes # getParams Extract parameters from specification # getAlpha Extracts target VaR-alpha specification # getA Extracts quadratic LPM Exponent # FUNCTION: DESCRIPTION: # getPortfolio Extract whole portfolio slot # getWeights Extracts weights from a portfolio object # getTargetReturn Extracts target return from specification # getTargetRisk Extracts target riks from specification # getRiskFreeRate Extracts risk free rate from specification # getNFrontierPoints Extracts number of frontier points # getStatus Extracts portfolio status information # FUNCTION: DESCRIPTION: # getOptim Extract whole optim slot # getSolver Extracts solver from specification # getObjective Extracs name of objective function # getOptions Extracs options # getControl Extracs control list parameters # getTrace Extracts solver's trace flag # FUNCTION: DESCRIPTION: # getMessages Extract whole messages slot ################################################################################ # fPFOLIOSPEC: # model = list( # type = "MV", # optimize = "minRisk", # estimator = "covEstimator", # tailRisk = NULL, # params = list(alpha = 0.05, a = 1)) # portfolio = list( # weights = NULL, # targetReturn = NULL, # targetRisk = NULL, # targetAlpha = NULL, # riskFreeRate = 0, # nFrontierPoints = 50, # status = 0) # optim = list( # solver = "solveRquadprog", # objective = NULL, # options = list(meq=2), # control = list(), # trace = FALSE) # messages = list(NULL) # ------------------------------------------------------------------------------ getModel.fPFOLIOSPEC <- function(object) object@model getType.fPFOLIOSPEC <- function(object) object@model$type[1] getOptimize.fPFOLIOSPEC <- function(object) object@model$optimize getEstimator.fPFOLIOSPEC <- function(object) object@model$estimator getTailRisk.fPFOLIOSPEC <- function(object) object@model$tailRisk getParams.fPFOLIOSPEC <- function(object) object@model$params getAlpha.fPFOLIOSPEC <- function(object) object@model$params$alpha getA.fPFOLIOSPEC <- function(object) object@model$params$a .getEstimatorFun <- function(object) match.fun(getEstimator(object)) # ------------------------------------------------------------------------------ getPortfolio.fPFOLIOSPEC <- function(object) object@portfolio getWeights.fPFOLIOSPEC <- function(object) object@portfolio$weights getTargetReturn.fPFOLIOSPEC <- function(object) object@portfolio$targetReturn getTargetRisk.fPFOLIOSPEC <- function(object) object@portfolio$targetRisk getRiskFreeRate.fPFOLIOSPEC <- function(object) object@portfolio$riskFreeRate getNFrontierPoints.fPFOLIOSPEC <- function(object) object@portfolio$nFrontierPoints getStatus.fPFOLIOSPEC <- function(object) object@portfolio$status # ------------------------------------------------------------------------------ getOptim.fPFOLIOSPEC <- function(object) object@optim getSolver.fPFOLIOSPEC <- function(object) object@optim$solver getObjective.fPFOLIOSPEC <- function(object) object@optim$objective getOptions.fPFOLIOSPEC <- function(object) object@optim$options getControl.fPFOLIOSPEC <- function(object) object@optim$control getTrace.fPFOLIOSPEC <- function(object) object@optim$trace # ------------------------------------------------------------------------------ getMessages.fPFOLIOSPEC <- function(object) object@messages ################################################################################ fPortfolio/R/portfolio-feasiblePfolio.R0000644000175100001440000001107312323217770017703 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # feasiblePortfolio Returns a feasible portfolio ################################################################################ feasiblePortfolio <- function(data, spec = portfolioSpec(), constraints = "LongOnly") { # A function implemented Diethelm Wuertz # Description: # Computes Risk and Return for a feasible portfolio # Arguments: # data - a rectangular timeSeries object of assets # spec - an object of class 'fPFOLIOSPEC' # constraints - a character vector or NULL # FUNCTION: # Data and Assets Names: Data <- portfolioData(data, spec) if(class(data) == "fPFOLIODATA") data <- getSeries(Data) assetsNames <- getUnits(Data) # Specification: Spec <- spec # Constraints: Constraints <- portfolioConstraints(Data, spec, constraints) # Get Weights: if(is.null(getWeights(spec))) { stop("Missing weights") } weights <- as.vector(getWeights(spec)) names(weights) <- assetsNames if (class(getSeries(Data)) == "timeSeries") { # Compute Returns: targetReturn <- c( mean = (Data@statistics$mean %*% weights)[[1]], mu = (Data@statistics$mu %*% weights)[[1]]) setTargetReturn(spec) <- targetReturn # Compute Covariance Risk: Cov <- Data@statistics$Cov cov <- sqrt((weights %*% Cov %*% weights)[[1]]) # Check Solver: # if (any(constraints@stringConstraints == "Short")) { # setSolver(spec) = "solveRshortExact" # warning("Short Constraints Specified: Solver forced to solveRshortExact") # } # Compute Alternative/Robust Covariance Risk: if (getType(spec) == "SPS") { myCheck <- TRUE funSigma <- match.fun(getObjective(spec)[1]) rcov <- funSigma(as.vector(weights)) } else { Sigma <- Data@statistics$Sigma rcov <- sqrt((weights %*% Sigma %*% weights)[[1]]) } # Compute VaR: alpha <- getAlpha(spec) returns <- getDataPart(getSeries(Data)) %*% weights VaR <- quantile(returns, alpha, type = 1) # Compute CVaR: CVaR <- VaR - 0.5*mean(((VaR-returns) + abs(VaR-returns))) / alpha # Compose Risks: targetRisk <- c(cov, rcov, -CVaR, -VaR) names(targetRisk) <- c("Cov", "Sigma", "CVaR", "VaR") alpha <- getAlpha(Spec) } else if (class(getSeries(Data)) == "logical") { # Compute Returns: targetReturn <- c( mean = (Data@statistics$mean %*% weights)[[1]], mu = NA) setTargetReturn(spec) <- targetReturn # Compute Covariance Risk: Cov <- Data@statistics$Cov cov <- sqrt((weights %*% Cov %*% weights)[[1]]) # Compose Risks: targetRisk <- c(cov, NA, NA, NA) names(targetRisk) <- c("Cov", "Sigma", "CVaR", "VaR") alpha <- NA } # Compute Risk Budgets: covRiskBudgets <- (weights * Cov %*% weights)[, 1] / cov^2 names(covRiskBudgets) <- assetsNames # Compose Portfolio: Portfolio <- new("fPFOLIOVAL", portfolio = list( weights = weights, covRiskBudgets = covRiskBudgets, targetReturn = targetReturn, targetRisk = targetRisk, targetAlpha = alpha, status = getStatus(spec))) # Return Value: new("fPORTFOLIO", call = match.call(), data = Data, spec = Spec, constraints = Constraints, portfolio = Portfolio, title = "Feasible Portfolio", description = description() ) } ################################################################################ fPortfolio/R/mathprogNLP-nlminb2.R0000644000175100001440000002155012410277312016473 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # rnlminb2NLP Rmetrics Interface for NLMINB2 LP solvers # nlminb2NLP Convenience wrapper for NLMINB2 LP solvers # nlminb2Control NLMINB2 LP control parameter list # rnlminb2 Synonyme name for Rnlminb2::nlminb2 function ################################################################################ rnlminb2NLP <- function(start, objective, lower=0, upper=1, linCons, funCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Function wrapper for solver nlminb2() # FUNCTION: # Update Control List: ctrl <- nlminb2NLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl BIG <- 1e6 N <- length(start) # Box Constraints: if(length(lower) == 1) { par.lower <- rep(lower, N) } else { par.lower <- lower } if(length(upper) == 1) { par.upper <- rep(upper, N) } else { par.upper <- upper } par.lower[is.infinite(par.lower)] <- BIG*sign(par.lower[is.infinite(par.lower)]) par.upper[is.infinite(par.upper)] <- BIG*sign(par.upper[is.infinite(par.upper)]) # Linear Constraints: if(missing(linCons)) { eqA <- ineqA <- NULL eqA.bound <- ineqA.lower <- ineqA.upper <- NULL } else { mat <- linCons[[1]] lower <- linCons[[2]] upper <- linCons[[3]] if(length(lower) == 1) { lower <- rep(lower, N) } else { lower <- lower } if(length(upper) == 1) { upper <- rep(upper, N) } else { upper <- upper } lower[is.infinite(lower)] <- BIG*sign(lower[is.infinite(lower)]) upper[is.infinite(upper)] <- BIG*sign(upper[is.infinite(upper)]) eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) if (length(eqIndex) == 0) { eqA <- NULL eqA.bound <- NULL } else { eqA <- mat[eqIndex, ] eqA.bound <- lower[eqIndex] } if (length(ineqIndex) == 0) { ineqA <- NULL ineqA.lower <- NULL ineqA.upper <- NULL } else { ineqA <- mat[ineqIndex, ] ineqA.lower <- lower[ineqIndex] ineqA.upper <- upper[ineqIndex] } } # Nonlinear Constraints: if(missing(funCons)) { eqFun <- ineqFun <- list() eqFun.bound <- ineqFun.lower <- ineqFun.upper <- NULL } else { fun <- funCons[[1]] lower <- funCons[[2]] upper <- funCons[[3]] eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) if (length(eqIndex) == 0) { eqFun <- list() eqFun.boud <- NULL } else { eqFun <- fun[eqIndex] eqFun.bound <- lower[eqIndex] } if (length(ineqIndex) == 0) { ineqFun <- list() ineqFun.lower <- NULL ineqFun.upper <- NULL } else { ineqFun <- fun[ineqIndex] ineqFun.lower <- lower[ineqIndex] ineqFun.upper <- upper[ineqIndex] } } # Optimize Portfolio: optim <- nlminb2NLP( start = start, objective = objective, par.lower = par.lower, par.upper = par.upper, eqA = eqA, eqA.bound = eqA.bound, ineqA = ineqA, ineqA.lower = ineqA.lower, ineqA.upper = ineqA.upper, eqFun = eqFun, eqFun.bound = eqFun.bound, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper, control = control) # Return Value: value <- list( opt = optim, solution = optim$solution, objective = objective(optim$solution), status = optim$status, message = optim$message, solver = "nlminb2NLP") class(value) <- c("solver", "list") value } ############################################################################### nlminb2NLP <- function( start, objective, par.lower = NULL, par.upper = NULL, eqA = NULL, eqA.bound = NULL, ineqA = NULL, ineqA.lower = NULL, ineqA.upper = NULL, eqFun = list(), eqFun.bound = NULL, ineqFun = list(), ineqFun.lower = NULL, ineqFun.upper = NULL, control = list()) { # A function implemented by Diethelm Wuertz # Description: # Function wrapper for solver nlminb2() # FUNCTION: # Environment: env <- .GlobalEnv # Update Control List: ctrl <- nlminb2NLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl N <- length(start) # Set Box Constraints: if (is.null(par.lower)) par.lower <- -Inf if (is.null(par.upper)) par.upper <- +Inf if (length(par.lower) == 1) par.lower <- rep(par.lower, N) if (length(par.upper) == 1) par.upper <- rep(par.upper, N) # Set Linear and Function Equality Constraints: if (!is.null(eqA) || length(eqFun) > 0) { eqfun <- function(x) { ans <- NULL if(!is.null(eqA)) { ans <- c(ans, eqA %*% x - eqA.bound) } if (length(eqFun) > 0) for (i in 1:length(eqFun)) ans <- c(ans, eqFun[[i]](x) - eqFun.bound[i]) return(as.double(eval(ans, env))) } } else { eqfun <- NULL } # Set Linear and Function Inequality Constraints: if (!is.null(ineqA) || length(ineqFun) > 0) { leqfun <- function(x) { ans <- NULL if(!is.null(ineqA)) ans <- c(ans, +ineqA %*% x - ineqA.upper) if(!is.null(ineqA)) ans <- c(ans, -ineqA %*% x + ineqA.lower) if (length(ineqFun) > 0) for (i in 1:length(ineqFun)) ans <- c(ans, +ineqFun[[i]](x) - ineqFun.upper[i]) if (length(ineqFun) > 0) for (i in 1:length(ineqFun)) ans <- c(ans, -ineqFun[[i]](x) + ineqFun.lower[i]) return(as.double(eval(ans, env))) } } else { leqfun <- NULL } # Optimize Portfolio: optim <- rnlminb2( start = start, objective = objective, eqFun = eqfun, leqFun = leqfun, lower = par.lower, upper = par.upper, gradient = NULL, hessian = NULL, control = control, env = env) names(optim$par) <- names(start) # Return Value: value <- list( opt = optim, solution = optim$par, objective = objective(optim$par)[[1]], convergence = optim$convergence, message = optim$message, solver = "nlminb2NLP") class(value) <- c("solver", "list") # Return Value: value } ################################################################################ rnlminb2 <- function(...) { Rnlminb2::nlminb2(...) } ################################################################################ nlminb2NLPControl <- function(eval.max = 500, iter.max = 400, trace = 0, abs.tol = 1e-20, rel.tol = 1e-10, x.tol = 1.5e-08, step.min = 2.2e-14, scale = 1, R = 1, beta.tol = 1e-20) #, step.beta = 20) { # A function implemented by Diethelm Wuertz # FUNCTION: # Control Parameters: ans <- list(eval.max = eval.max, iter.max = iter.max, trace = trace, abs.tol = abs.tol, rel.tol = rel.tol, x.tol = x.tol, step.min = step.min, scale = scale, R = R, beta.tol = beta.tol) #, step.beta = step.beta) # Return Value: ans } ############################################################################### fPortfolio/R/backtest-netPerformance.R0000644000175100001440000002041512323217770017513 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # netPerformance Returns performance from a portfolio backtest # FUNCTION: DESCRIPTION: # .netPerformanceYTD Returns year-to-date performance # .netPerformanceCalendar Returns calendar performance # .netPerformancePlot Creates a net performance plot ################################################################################ # DW - TO DO: # Add argument doplot to function netPerformance # Make plot() a generic function # Problems in plot function # ------------------------------------------------------------------------------ netPerformance <- function(object, format = "%Y-%m-%d") { # A function implemented by William Chen # Description: # Returns performance from a portfolio backtest # Arguments: # object - an object as returned by the function portfolioSmoothing. # format - # FUNCTION: # Settings: cumP <- object$portfolioReturns cumB <- object$benchmarkReturns P <- as.numeric(cumP) B <- as.numeric(cumB) monthlyP <- object$P monthlyB <- object$B char.dates <- rownames(cumP) dates <- strptime(char.dates, format = format) # nye <- new years eve nye <- as.character(dates[dates$mon == 11] ) years <- substr(nye, 1,4) nYears <- length(years) # Net Performance Plot: # DW: Needs repair, all following plots fails once called # .netPerformancePlot(dates, char.dates, years, nye, P) # NET PERFORMANCE TO YTD: netYTD = rbind(.netPerformanceYTD(char.dates, monthlyP, P, nYears), .netPerformanceYTD(char.dates, monthlyB, B, nYears)) rownames(netYTD) = c("Portfolio", "Benchmark") # NET PERFORMANCE CALENDAR YEAR: netCalendar <- rbind(.netPerformanceCalendar(nye, char.dates, P), .netPerformanceCalendar(nye, char.dates, B)) rownames(netCalendar) = c("Portfolio", "Benchmark") # Print Summary: cat("\nNet Performance % to", paste(rev(char.dates)[1], ":",sep = ""), "\n") print(round(netYTD,2)) cat("\n\nNet Performance % Calendar Year:\n") print(round(netCalendar,2)) cat("\n") # Return Value: ans = list(YTD = netYTD, Calendar = netCalendar) invisible(ans) } # ------------------------------------------------------------------------------ .netPerformanceYTD = function(char.dates, monthlyP, P, nYears, ...) { # A function implemented by William Chen # Description: # Returns year-to-date performance from a portfolio backtest # Arguments: # FUNCTION: # NET PERFORMANCE TO YTD: # summaries for last 1, 3, 6 months, # 1 year, 3 years, 5 years, 3 years annualised, # 5 years annualised (if possible) monthly <- c(rev(monthlyP)[1], sum(rev(monthlyP)[1:3]), sum(rev(monthlyP)[1:6])) if (nYears >= 5){ IDX <- 1 + c(0,1,2,5)*12 yearly <- numeric(length(IDX)-1) for (i in 1:(length(IDX)-1)){ yearly[i] <- rev(P)[IDX[1]] - rev(P)[IDX[i+1]] } annualised <- c((1+yearly[2]/100)^(1/3) - 1, (1+yearly[3]/100)^(1/5) - 1) * 100 combine <- c(monthly, yearly, annualised) names(combine) = c("1 mth", paste(c(3,6), "mths"), "1 yr", paste(c(3,5), "yrs"), paste(c(3,5), "yrs p.a.")) } else { IDX <- 1 + seq(0, nYears) * 12 yearly <- numeric(length(IDX)-1) for (i in 1:(length(IDX)-1)){ yearly[i] <- rev(P)[IDX[1]] - rev(P)[IDX[i+1]] } Names = paste(seq(1:nYears), "yrs") # calculate some annualised rates if (nYears > 1){ ys <- seq(nYears) annualised <- NULL for (i in 2:nYears){ annualised = c(annualised, (1+yearly[i]/100)^(1/i)-1) } annualised <- annualised * 100 yearly <- c(yearly, annualised) Names <- c(Names, paste(2:nYears, "yrs p.a.")) } combine <- c(monthly, yearly) names(combine) <- c("1 mth", paste(c(3,6), "mths"), Names) } # Return Value: combine } # ------------------------------------------------------------------------------ .netPerformanceCalendar <- function(nye, char.dates, P, ...) { # A function implemented by William Chen # Description: # Returns calendar performance # Arguments: # FUNCTION: # Net Performance Calendar Year: nye1 = c(nye, char.dates[length(char.dates)]) # First entry is the cumulated return at the end of first year # assume we start with 0 returns annuals <- P[char.dates == nye[1]] for (i in 1:(length(nye1)-1)){ annuals <- c(annuals, P[char.dates == nye1[i+1]] - P[char.dates == nye1[i]]) } Annual <- c(annuals, sum(annuals)) names(Annual) <- c(substr(nye,1,4), "YTD", "Total") # Return Value: Annual } # ------------------------------------------------------------------------------ .netPerformancePlot <- function(dates, char.dates, years, nye, P, base = 100) { # A function implemented by William Chen # Description: # Creates a net performance plot # Arguments: # FUNCTION: # NET PERFORMANCE PLOT: # Setup figure frame: Opar = par(oma = rep(0,4), mar = rep(0,4)) mat <- matrix(c(1,2,3), nrow = 3, ncol = 1) mat <- rbind(0, cbind(0, mat, 0)) layout(mat, widths = c(0, 1, 0), heights = c(lcm(0.3), lcm(0.8), 1, lcm(1))) # Add title: plot.new() plot.window(xlim = c(0,1), ylim = c(0,1)) rect(0,0,1,1,col = "grey50", border = NA) text(0.01,0.5, "Net Performance (rebased to 100)", font = 2, col = "white", adj = 0, cex = 1.8) # Rebased to 100 newP <- c(base, P + base) # limits: ylim.pretty <- pretty(newP) yLim = range(ylim.pretty) # extend to the end of calendar year shortCalendar <- 11 - rev(dates$mon)[1] xLim <- c(1, length(char.dates) + shortCalendar) # Create empty canvas: opar <- par(mar = c(2,5,1,4)) plot.new() plot.window(xlim = xLim, ylim = yLim, xaxs = "i", yaxs = "i") # Add bottom axes: IDX <- match(nye, char.dates) temp.d <- ifelse(dates$mon[1] != 0, dates$mon[1], 12) temp.y <- ifelse(temp.d == 12, as.numeric(years)[1]-1, as.numeric(years)[1]) labs <- c(paste(temp.d, temp.y, sep = "/"), paste(12, years, sep = "/")) if (shortCalendar !=0 ) labs = c(labs, paste(12, as.numeric(rev(years))[1] + 1, sep = "/")) axis(1, at = sort(c(xLim,IDX + 1)), labels = labs, cex.axis = 1, padj = 0.5)#, tck = -0.05) # Add left axes: yseq <- seq(min(ylim.pretty), max(ylim.pretty), by = 5) axis(2, at = yseq, las = 1, tick = FALSE, line = -0.7) abline(h = yseq, col = "grey50") # Draw portfolio performance: lines(newP, col = "red", lwd = 2) par(opar) # Add legend and extra text: plot.new() plot.window(xlim = c(0,1), ylim = c(0,1)) legend(0.015, 0.8, legend = "Portfolio", lty = "solid", lwd = 2, col = "red", bty = "n", cex = 1.1) # Return Value: par(Opar) invisible() } ################################################################################ fPortfolio/R/risk-covEstimator.R0000644000175100001440000004617212410246734016401 0ustar hornikusers ################################################################################ # FUNCTION: DESCRIPTION: # covEstimator Uses sample covariance estimation # mveEstimator Uses robust estimation "cov.mve" from [MASS] # mcdEstimator Uses robust estimation "cov.mcd" from [MASS] # FUNCTION: DESCRIPTION: # lpmEstimator Returns Lower Partial Moment Estimator # slpmEstimator Returns Symmetric Lower Partial Moment Estimator # FUNCTION: DESCRIPTION: # kendallEstimator Returns Kendall's Covariance Estimator # spearmanEstimator Returns Spearman's Covariance Estimator # FUNCTION: DESCRIPTION: # covMcdEstimator Requires "covMcd" from [robustbase] # covOGKEstimator Requires "covOGK" from [robustbase] # shrinkEstimator Requires "cov.shrink" from [corpcor] # nnveEstimator Requires "cov.nnve" from [covRobust] # FUNCTION: DESCRIPTION: # .studentEstimator uses "cov.trob" from [MASS] # .baggedEstimator uses builtin from [corpcor] # .donostahEstimator uses builtin from [robust] # .bayesSteinEstimator copy from Alexios Ghalanos # .ledoitWolfEstimator uses builtin from [tawny] # .rmtEstimator uses builtin from [tawny] # FUNCTION: DESCRIPTION: # .mveEstimator2 Uses robust estimation "cov.mve" from [MASS] # .mcdEstimator2 Uses robust estimation "cov.mcd" from [MASS] # .covMcdEstimator2 Requires "covMcd" from [robustbase] # .covOGKEstimator2 Requires "covOGK" from [robustbase] # .arwEstimator2 Uses robust estimation ".cov.arw"from [mvoutlier] ################################################################################ covEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses sample covariance estimation # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; covEstimator(x) # FUNCTION: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu = colMeans(x.mat) Sigma = cov(x.mat) # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ mveEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses robust estimation "cov.mve" from [MASS] # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; mveEstimator(x) # FUNCTION: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: { mu = colMeans(x.mat) Sigma = MASS::cov.rob(x = x.mat, method = "mve")$cov # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ mcdEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses robust estimation "cov.mve" from [MASS] # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; mcdEstimator(x) # FUNCTION: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu = colMeans(x.mat) Sigma = MASS::cov.rob(x = x.mat, method = "mcd")$cov # Return Value: list(mu = mu, Sigma = Sigma) } ################################################################################ lpmEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Returns lower partial moment estimator # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; lpmEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu <- colMeans(x) if (is.null(spec)) { FUN = colMeans a = 2 } else { FUN = match.fun(spec@model$param$tau) a = spec@model$param$a } Sigma <- assetsLPM(x, tau = FUN(x), a = a)$Sigma colnames(Sigma) <- rownames(Sigma) <- names(mu) # Return Value: list(mu = mu, Sigma = Sigma) } ################################################################################ slpmEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Returns symmetric lower partial moment estimator # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; slpmEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu <- colMeans(x) if (is.null(spec)) { FUN = colMeans a = 2 } else { FUN = match.fun(spec@model$param$tau) a = spec@model$param$a } Sigma <- assetsSLPM(x, tau = FUN(x), a = a)$Sigma colnames(Sigma) <- rownames(Sigma) <- names(mu) # Return Value: list(mu = mu, Sigma = Sigma) } ################################################################################ kendallEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses Kendall's rank covariance estimation # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; covEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu = colMeans(x.mat) Sigma = cov(x.mat, method = "kendall") # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ spearmanEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses Spearman's rank covariance estimation # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; covEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu = colMeans(x.mat) Sigma = cov(x.mat, method = "spearman") # Return Value: list(mu = mu, Sigma = Sigma) } ################################################################################ covMcdEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; covMcdEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu = colMeans(x.mat) Sigma = robustbase::covMcd(x.mat, alpha = 1/2, ...)$cov # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ covOGKEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; covOGKEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu = colMeans(x.mat) Sigma = robustbase::covOGK(x.mat, sigmamu = robustbase::scaleTau2, ...)$cov colnames(Sigma) <- rownames(Sigma) <- names(mu) # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ shrinkEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Eample: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; shrinkEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu = colMeans(x.mat) Sigma = fAssets:::.cov.shrink(x = x.mat, verbose = FALSE, ...) attr(Sigma, "lambda.var") <- NULL attr(Sigma, "lambda.var.estimated") <- NULL # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ nnveEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Eample: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; nnveEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: mu = colMeans(x.mat) Sigma = fAssets:::.cov.nnve(datamat = x.mat, ...)$cov colnames(Sigma) <- rownames(Sigma) <- names(mu) # Return Value: list(mu = mu, Sigma = Sigma) } ################################################################################ .studentEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses mean/student-d covariance estimation # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Note: # Source from package MASS # Eample: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; .studentEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: robust = fAssets:::.studentMeanCov(x.mat, ...) mu = robust$center Sigma = robust$cov # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ .baggedEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses bagged mean/covariance estimation # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Note: # Source from package corpcor # Eample: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; .baggedEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: robust = fAssets:::.baggedMeanCov(x, ...) mu = robust$center Sigma = robust$cov # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ .donostahEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Description: # Uses Donostah's mean/covariance estimation # Note: # Source from package robust # Eample: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; .donostahEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: robust = fAssets:::.donostahMeanCov(x, ...) mu = robust$center Sigma = robust$cov # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ .bayesSteinEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses Bayes Stein mean/covariance estimation # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Note: # Source from Alexios Ghalanos # Eample: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; .bayesSteinEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: robust = fAssets:::.bayesSteinMeanCov(x, ...) mu = robust$center Sigma = robust$cov # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ .ledoitWolfEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses Ledoit-Wolf mean/covariance estimation # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Note: # Source from package tawny # Eample: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; .ledoitWolfEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: robust = fAssets:::.ledoitWolfMeanCov(x, ...) mu = robust$center Sigma = robust$cov # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ .rmtEstimator <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses Random Matrix Theory correlation estimation # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Note: # Source from package tawny # Eample: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; .rmtEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: robust = fAssets:::.rmtMeanCov(x, ...) mu = robust$center Sigma = robust$cov # Return Value: list(mu = mu, Sigma = Sigma) } ################################################################################ .mveEstimator2 <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses robust estimation "cov.mve" from [MASS] # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; mveEstimator(x) # FUNCTION: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: ans = MASS::cov.rob(x = x.mat, method = "mve") mu = ans$center Sigma = ans$cov # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ .mcdEstimator2 <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Uses robust estimation "cov.mve" from [MASS] # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; mcdEstimator(x) # FUNCTION: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: ans = MASS::cov.rob(x = x.mat, method = "mcd") mu = ans$center Sigma = ans$cov # Return Value: list(mu = mu, Sigma = Sigma) } ################################################################################ .covMcdEstimator2 <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; covMcdEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: ans = robustbase::covMcd(x.mat, alpha = 1/2, ...) mu = ans$center Sigma = ans$cov # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ .covOGKEstimator2 <- function(x, spec = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # x - an object of class timeSeries # spec - a portfolio specification of class fPFOLIOSPEC # Example: # x = as.timeSeries(data(LPP2005REC))[, 1:6]; covOGKEstimator(x) # FUNCTION: # Check Arguments: stopifnot(inherits(x, "timeSeries")) # Extract Matrix: x.mat = getDataPart(x) # Estimate: ans = robustbase::covOGK(x.mat, sigmamu = robustbase::scaleTau2, ...) mu = ans$center Sigma = ans$cov colnames(Sigma) <- rownames(Sigma) <- names(mu) # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ .arwEstimator2 <- function (x, spec = NULL, ...) { x.mat <- as.matrix(x) N <- ncol(x) assetNames <- colnames(x) fit <- fAssets:::.cov.arw(x = x.mat, center = colMeans(x.mat), cov = cov(x) , ...) # Estimate: mu <- fit$center Sigma <- fit$cov names(mu) <- assetNames rownames(Sigma) <- colnames(Sigma) <- assetNames # Return Value: list(mu = fit$center, Sigma = fit$cov) } ################################################################################ fPortfolio/R/frontier-getPoints.R0000644000175100001440000000664512323217770016560 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # frontierPoints Extracts the efficient frontier from a 'fPORTFOLO' object ################################################################################ frontierPoints <- function(object, frontier = c("both", "lower", "upper"), return = c("mean", "mu"), risk = c("Cov", "Sigma", "CVaR", "VaR"), auto = TRUE) { # A function implemented by Diethelm Wuertz # Description: # Extracts the efficient frontier from a 'fPORTFOLO' object # Arguments: # object - an object of S4 class fPORTFOLIO as returned by the # functions fooPortfolio(). # frontier - a character string, which part of the frontier # should be extracted # return, rrisk - a character string, which return or risk # measures should be selected # auto - a logical, allows auto selection for the return and # risk measure depending on # FUNCTION: # Settings: frontier = match.arg(frontier) # Match Arguments: return = match.arg(return) risk = match.arg(risk) # Get Efficient Frontier: if (auto) { Type = getType(object) Estimator = getEstimator(object) if (Type == "MV") risk = "Cov" if (Type == "MV" & Estimator != "covEstimator") risk = "Sigma" if (Type == "QLPM") risk = "Sigma" if (Type == "CVaR") risk = "CVaR" } if (is.vector(getTargetRisk(object@portfolio))) { targetRisk = getTargetRisk(object@portfolio)[risk] targetReturn = getTargetReturn(object@portfolio)[return] } else { targetRisk = getTargetRisk(object@portfolio)[, risk] targetReturn = getTargetReturn(object@portfolio)[, return] } # Extract Whole Frontier: ans = cbind(Risk = targetRisk, Return = targetReturn) # Extract "upper|lower" Part of Frontier: if(frontier == "upper"){ index = 1:length(ans[, 1]) test = c(-1, diff(ans[, 1])) index = index[test > 0] ans = ans[index, ] } else if(frontier == "lower"){ index = 1:length(ans[, 1]) test = c(-1, diff(ans[, 1])) index = index[test < 0] if (length(index) == 1) { ans = matrix(ans[index, ], ncol = 2) } else { ans = ans[index, ] } } # Add Colnames: colnames(ans) = c("targetRisk", "targetReturn") rownames(ans) = as.character(1:NROW(ans)) attr(ans, "control") <- c(targetRisk = risk, targetReturn = return, auto = as.character(auto)) # Return Value: ans } ################################################################################ fPortfolio/R/risk-tailBudgets.R0000644000175100001440000004256312703721404016166 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # .tailDependenceCoeffs Returns Lower and Upper Tail Dependence Coeffs # FUNCTION: MIXED GUMBEL-SURVIVALGUMBEL-NORMAL COPULA: # .rgsgnormCopula Generates G-SG-NORM copula random variates # .dgsgnormCopula Computes G-SG-NORM copula density # FUNCTION: MIXED G-SG-NORM COPULA FIT: # .gsgnormCopulaFit Estimates the parameters of the G-SG-NORM copula # FUNCTION: NON-PARAMETRIC TAIL DEPENDECY ESTIMATOR: # .cfgTDE Estimates non-parametrically tail dependence # FUNCTION: COPULA FIT WITH NORM, NIG OR GHT MARGINALS: # .empiricalDependencyFit Estimates tail dependence with empirical marginals # .normDependencyFit Estimates tail dependence with normal marginals # .gldDependencyFit Estimates tail dependence with GLD marginals # .ghtDependencyFit Estimates tail dependence with GHT marginals ################################################################################ .tailDependenceCoeffs <- function(x, method = c("nig", "norm", "ght"), trace = FALSE, doplot = TRUE) { # A function implemented by Diethelm Wuertz # Description: # Returns a list with lower and upper bivariate tail depenence matrixes # Example: # x <- 100 * LPP2005.RET[, 1:6]; .tailDependenceCoeffs(x) # Notes: # Tested only for NIG marginal distributions. # FUNCTION: # Check Settings: method <- match.arg(method) # Compute Coeffs with desired Marginals: fun <- paste(".", method, "DependencyFit", sep = "") funFit <- match.fun(fun) coeffs <- funFit(x, doplot = doplot, trace = trace) # Return Value: coeffs } ################################################################################ .rgsgnormCopula <- function(n = 1000, alpha = c(2, 2), rho = 0, weights = c(1/3, 1/3)) { # A function implemented by Diethelm Wuertz # Description: # Computes RVs from a mixed Gumbel-SurvivalGumbel-Normal Copula # Arguments: # n - an integer value, the number of random variates to be # generated. # alpha - a numeric vector with two entries. The first denotes # the parameter value of alpha for the Gumbel copula, and # the second for the Survival Gumbel Copula. # rho - a numeric value denoting the correlation parameter for # the normal copula. # weights - a numeric vector with two entries. The first denotes # the weight of the Gumbel copula, and the second the weight # of the Survival Gumbel Copula. The weight for the normal # copula is evaluated by 1 - sum(weights). # Example: # .rgsgnormCopula(20) # FUNCTION: # Checking: stopifnot(any(weights >= 0)) stopifnot(sum(weights) <= 1) # Upper Gumbel = 1 , Lower Gumbel = 2, t = 3: weights <- c(weights, 1-sum(weights)) N <- round(n*weights[1:2]) N <- c(N, n-sum(N)) # Random Variates: r <- rbind( if (N[1] > 0) fCopulae::rgumbelCopula(N[1], alpha[1]), if (N[2] > 0) 1-fCopulae::rgumbelCopula(N[2], alpha[2]), if (N[3] > 0) fCopulae::rellipticalCopula(N[3], rho, type = "norm") ) index <- sample(1:n) ans <- r[index, ] N <- c(n, N) names(N) <- c("n", "n1", "n2", "n3") attr(ans, "control") < -N # Return Value: ans } # ------------------------------------------------------------------------------ .dgsgnormCopula <- function(u = 0.5, v = u, alpha = c(2, 2), rho = 0, weights = c(1/3, 1/3), output = c("vector", "list")) { # A function implemented by Diethelm Wuertz # Description: # Computes mixed Gumbel-SurvivalGumbel-Normal Copula density # Example: # .perspPlot(.dgsgnormCopula(u=grid2d()$x, v=grid2d()$y, output = "list")) # FUNCTION: # Settings: if (is.list(u)) { v = u[[2]] u = u[[1]] } if (is.matrix(u)) { v = u[, 1] u = u[, 2] } # Match Arguments: output = match.arg(output) # Mixed Copula: weights <- c(weights, 1-sum(weights)) dCopula1 <- fCopulae::dgumbelCopula(u, v, alpha[1]) dCopula2 <- fCopulae::dgumbelCopula(1-u, 1-v, alpha[2]) dCopula3 <- fCopulae::dellipticalCopula(u, v, rho, type = "norm") c.uv <- weights[1]*dCopula1 + weights[2]*dCopula2 + weights[3]*dCopula3 attr(c.uv, "control") <- c(alpha = alpha, rho = rho, weights = weights) if (output == "list") { N = sqrt(length(u)) x = u[1:N] y = matrix(v, ncol = N)[1, ] c.uv = list(x = x, y = y, z = matrix(c.uv, ncol = N)) } # Return Value: c.uv } # ------------------------------------------------------------------------------ .gsgnormCopulaFit <- function(u, v = NULL, trace = FALSE) { # A function implemented by Diethelm Wuertz # Description: # Fits parameters for a mixed GSG copula # FUNCTION: # Settings: U <- u V <- v if (is.list(u)) { U = u[[1]] V = u[[2]] } if (is.matrix(u)) { U = u[, 1] V = u[, 2] } # From weights to gamma ... # G-SG-NORM: W1*Gumbel + W2*SurvivalGumbul + W3*NORM # with W3 = 1-W2-W3 # Transformation: Use Weights W1 and W3 # gamma = c(gamma1, gamma2) # 0 < gamma1 = W1/(1-W3) < 1 # 0 < gamma2 = 1-W3 < 1 # W3 = 1-gamma2 # W1 = gamma1*gamma2 # W2 = gamma2*(1-gamma1) # Note, this transformation has the advantage, that gamma1 # and gamma2 are independent from each other. # Estimate Copula: start = c(alpha1 = 1.5, alpha2 = 1.5, rho = 0, gamma1 = 1/2, gamma2 = 1/2) fun = function(x, U, V, trace) { alpha = x[1:2] rho = x[3] gamma = x[4:5] weights = c( weights1 = gamma[[1]]*gamma[[2]], weights2 = gamma[[2]]*(1-gamma[[1]])) density = .dgsgnormCopula(u = U, v = V, alpha, rho, weights = weights) density = density[!is.na(density)] f = -mean( log(density) ) if (trace) { params = round(c(x[1:3], weights[1], weights[2], 1-weights[1]-weights[2]), 4) names(params) = c("alpha1", "alpha2", "rho", "gumbel", "survival", "norm") cat("\n Objective Function Value: ", -f) cat("\n Parameter Estimates: ", params, "\n") } f } # Fit: fit = nlminb( start = start, objective = fun, lower = c( 1, 1, -0.999, 0, 0), upper = c(Inf, Inf, 0.999, 1, 1), U = U, V = V, trace = trace) # Fitted Parameters: param = fit$par # Named Parameters: alpha1 = param[1] alpha2 = param[2] rho = param[3] gamma1 = param[4] gamma2 = param[5] # Weights: weights3 = 1-gamma2 weights1 = gamma1*gamma2 weights2 = gamma2*(1-gamma1) # Tail Coefficients upperLambda = (weights1*(2 - 2^(1/alpha1)))[[1]] lowerLambda = (weights2*(2 - 2^(1/alpha2)))[[1]] params = c(param[1:3], param[5]*param[4], param[5]*(1-param[4]), 1-param[5]) names(params) = c("alpha1", "alpha2", "rho", "gumbel", "survival", "norm") Lambda = c(lower = lowerLambda, upper = upperLambda) # Return Value: list(param = params, lambda = Lambda, fitted = fit$par) } ################################################################################ .cfgTDE <- function(x, y) { # A function implemented by Diethelm Wuertz # Description: # Estimates non-parametrically tail dependency coefficient # FUNCTION: # Upper Tail: lambda = NULL n = length(x) for(i in 1:n){ lambda = c(lambda, log(sqrt(log(1/x[i])*log(1/y[i]))/log(1/max(x[i],y[i])^2))) } upper <- 2 - 2*exp(sum(lambda/n)) # Lower Tail: x = 1-x y = 1-y lambda = NULL n = length(x) for(i in 1:n){ lambda = c(lambda, log(sqrt(log(1/x[i])*log(1/y[i]))/log(1/max(x[i],y[i])^2))) } lower <- 2 - 2*exp(sum(lambda/n)) # Return Value: c(lower = lower, upper = upper) } ################################################################################ .empiricalDependencyFit <- function(x, doplot = TRUE, trace = FALSE) { # A function implemented by Diethelm Wuertz # Description: # Estimates tail dependency coefficients with Normal marginals # Arguments: # x - a multivariate 'timeSeries' object # FUNCTION: # Settings: N = ncol(x) lowerLambda = upperLambda = 0*diag(N) assetsNames = colnames(x) P = NULL for (i in 1:(N-1)) { # First asset: r1 = as.vector(x[, i]) fit1 = nFit(r1) estim1 = fit1@fit$estimate p1 = pnorm(r1, estim1[1], estim1[2]) Main1 = assetsNames[i] P = cbind(P, p1) for (j in (i+1):N) { # Second asset: r2 = as.vector(x[, j]) fit2 = nFit(r2) estim2 = fit2@fit$estimate p2 = pnorm(r2, estim2[1], estim2[2]) Main2 = assetsNames[j] # Optional Plot: if (doplot) { # Plot Distribution: MainR = paste("Distribution:", Main1, "-", Main2) plot(r1, r2, pch = 19, main = MainR) grid() # Plot Copula: MainP = paste("Copula:", Main1, "-", Main2) plot(p1, p2, pch = 19, main = MainP) grid() } # Fit GSG copula parameters: fit = .gsgnormCopulaFit(u = p1, v = p2, trace = trace) if (trace) cat(assetsNames[c(i,j)], round(fit$lambda, 3), "\n") # Compose lambda Matrix: lowerLambda[i, j] = lowerLambda[j, i] = fit$lambda[1] upperLambda[i, j] = upperLambda[j, i] = fit$lambda[2] } } # Result: colnames(lowerLambda) = rownames(lowerLambda) = assetsNames colnames(upperLambda) = rownames(upperLambda) = assetsNames ans = list(lower = lowerLambda, upper = upperLambda) # Return Value: ans } # ------------------------------------------------------------------------------ .normDependencyFit <- function(x, doplot = TRUE, trace = FALSE) { # A function implemented by Diethelm Wuertz # Description: # Estimates tail dependency coefficients with Normal marginals # Arguments: # x - a multivariate 'timeSeries' object # FUNCTION: # Settings: N = ncol(x) lowerLambda = upperLambda = 0*diag(N) assetsNames = colnames(x) P = NULL for (i in 1:(N-1)) { # First asset: r1 = as.vector(x[, i]) fit1 = nFit(r1) estim1 = fit1@fit$estimate p1 = pnorm(r1, estim1[1], estim1[2]) Main1 = assetsNames[i] P = cbind(P, p1) for (j in (i+1):N) { # Second asset: r2 = as.vector(x[, j]) fit2 = nFit(r2) estim2 = fit2@fit$estimate p2 = pnorm(r2, estim2[1], estim2[2]) Main2 = assetsNames[j] # Optional Plot: if (doplot) { # Plot Distribution: MainR = paste("Distribution:", Main1, "-", Main2) plot(r1, r2, pch = 19, main = MainR) grid() # Plot Copula: MainP = paste("Copula:", Main1, "-", Main2) plot(p1, p2, pch = 19, main = MainP) grid() } # Fit GSG copula parameters: fit = .gsgnormCopulaFit(u = p1, v = p2, trace = trace) if (trace) cat(assetsNames[c(i,j)], round(fit$lambda, 3), "\n") # Compose lambda Matrix: lowerLambda[i, j] = lowerLambda[j, i] = fit$lambda[1] upperLambda[i, j] = upperLambda[j, i] = fit$lambda[2] } } # Result: colnames(lowerLambda) = rownames(lowerLambda) = assetsNames colnames(upperLambda) = rownames(upperLambda) = assetsNames ans = list(lower = lowerLambda, upper = upperLambda) # Return Value: ans } # ------------------------------------------------------------------------------ .gldDependencyFit <- function(x, doplot = TRUE, trace = FALSE) { # A function implemented by Diethelm Wuertz # Description: # Estimates tail dependency coefficients with NIG marginals # Arguments: # x - a multivariate 'timeSeries' object # FUNCTION: # Settings: N <- ncol(x) lowerLambda <- upperLambda <- 0*diag(N) assetsNames <- colnames(x) P <- NULL for (i in 1:(N-1)) { # First asset: r1 <- as.vector(x[, i]) fit1 <- gldFit(r1, doplot = FALSE, trace = trace) estim1 <- fit1@fit$estimate p1 <- pgld(r1, estim1[1], estim1[2], estim1[3], estim1[4]) Main1 <- assetsNames[i] P <- cbind(P, p1) for (j in (i+1):N) { # Second asset: r2 <- as.vector(x[, j]) fit2 <- gldFit(r2, doplot = FALSE, trace = trace) estim2 = fit2@fit$estimate p2 <- pgld(r2, estim2[1], estim2[2], estim2[3], estim2[4]) Main2 <- assetsNames[j] # Optional Plot: if (doplot) { ## MainR = paste("Distribution:", Main1, "-", Main2) ## plot(r1, r2, pch = 19, main = MainR) ## grid() MainP <- paste("Copula:", Main1, "-", Main2) plot(p1, p2, pch = 19, main = MainP, xlab = "", ylab = "", cex=0.5) grid() } # Fit GSG copula parameters: fit <- .gsgnormCopulaFit(u = p1, v = p2, trace = trace) if (trace) cat(assetsNames[c(i,j)], round(fit$lambda, 3), "\n") # Compose lambda Matrix: lowerLambda[i, j] <- lowerLambda[j, i] <- fit$lambda[1] upperLambda[i, j] <- upperLambda[j, i] <- fit$lambda[2] } } # Result: colnames(lowerLambda) <- rownames(lowerLambda) <- assetsNames colnames(upperLambda) <- rownames(upperLambda) <- assetsNames ans = list(lower = lowerLambda, upper = upperLambda) # Return Value: ans } # ------------------------------------------------------------------------------ .ghtDependencyFit <- function(x, doplot = TRUE, trace = FALSE) { # A function implemented by Diethelm Wuertz # Description: # Estimates tail dependency coefficients with GH Student-t marginals # Arguments: # x - a multivariate 'timeSeries' object # FUNCTION: # Settings: N = ncol(x) lowerLambda = upperLambda = 0*diag(N) assetsNames = colnames(x) P = NULL for (i in 1:(N-1)) { # First asset: r1 = as.vector(x[, i]) fit1 = ghtFit(r1, doplot = FALSE, trace = trace) estim1 = fit1@fit$estimate p1 = pght(r1, estim1[1], estim1[2], estim1[3], estim1[4]) Main1 = assetsNames[i] P = cbind(P, p1) for (j in (i+1):N) { # Second asset: r2 = as.vector(x[, j]) fit2 = ghtFit(r2, doplot = FALSE, trace = trace) estim2 = fit2@fit$estimate p2 = pght(r2, estim2[1], estim2[2], estim2[3], estim2[4]) Main2 = assetsNames[j] # Optional Plot: if (doplot) { MainR = paste("Distribution:", Main1, "-", Main2) plot(r1, r2, pch = 19, main = MainR) grid() MainP = paste("Copula:", Main1, "-", Main2) plot(p1, p2, pch = 19, main = MainP) grid() } # Fit GSG copula parameters: fit = .gsgnormCopulaFit(u = p1, v = p2, trace = trace) if (trace) cat(assetsNames[c(i,j)], round(fit$lambda, 3), "\n") # Compose lambda Matrix: lowerLambda[i, j] = lowerLambda[j, i] = fit$lambda[1] upperLambda[i, j] = upperLambda[j, i] = fit$lambda[2] } } # Result: colnames(lowerLambda) = rownames(lowerLambda) = assetsNames colnames(upperLambda) = rownames(upperLambda) = assetsNames ans = list(lower = lowerLambda, upper = upperLambda) # Return Value: ans } ################################################################################ fPortfolio/R/a-class-fPORTFOLIO.R0000644000175100001440000000246712323217770016020 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # 'fPORTFOLIO' S4 Portfolio Class ################################################################################ setClass("fPORTFOLIO", representation( call = "call", data = "fPFOLIODATA", spec = "fPFOLIOSPEC", constraints = "fPFOLIOCON", portfolio = "fPFOLIOVAL", title = "character", description = "character") ) ################################################################################ fPortfolio/R/mathprogQP.R0000644000175100001440000001030512410257552015023 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # rsolveQP General Interface for QP solvers # .solveQP.MV.demo ############################################################################### rsolveQP <- function(objective, lower=0, upper=1, linCons, control=list(solver="quadprog", invoke=c("R", "AMPL", "NEOS"))) { # A function implemented by Diethelm Wuertz # Description: # Implements general function wrapper for QP solvers # Arguments: # objective - list(dvec=NULL, Dmat=NULL) # lower - lower box constraints # upper - upper box constraints # linCons - linear constraints, list with entries: # mat, lower, upper. # control - control list # FUNCTION: # Control: solver <- control$solver invoke <- control$invoke[1] # Solve Linear Problem: if (invoke == "R") { rfooLP <- match.fun ( paste("r", solver, "QP", sep="")) ans <- rfooLP(objective, lower, upper, linCons, control) } if (invoke == "AMPL" ) { ans <- ramplQP(objective, lower, upper, linCons, control) } if (invoke == "NEOS" ) { ans <- rneosQP(objective, lower, upper, linCons, control) } ans$solver <- paste(invoke, ans$solver) # Return Value: ans } ############################################################################### .solveQP.MV.demo <- function() { # Solve Mean-Variance Portfolio: # Load Dataset dataSet <- data("LPP2005REC", package="timeSeries", envir=environment()) LPP2005REC <- get(dataSet, envir=environment()) # Load Swiss Pension Fund Data: nAssets <- 6 data <- 100 * LPP2005REC[, 1:nAssets] # Arguments: objective <- list(dvec=rep(0, nAssets), Dmat=cov(data)) lower <- 0 upper <- 1 mat <- rbind( budget = rep(1, times=nAssets), returns = colMeans(data)) matLower <- c( budget = 1, return = mean(data)) matUpper <- matLower linCons <- list(mat, matLower, matUpper) control <- list() # R Contributed Solvers: rquadprogQP(objective, lower, upper, linCons) ripopQP(objective, lower, upper, linCons) # Default - AMPL Interface: ampl <- ramplQP(objective, lower, upper, linCons) ampl # All AMPL: for (solver in c( "cplex", "donlp2", "loqo", "lpsolve", "minos", "snopt", "ipopt", "bonmin", "couenne")) { ans <- ramplQP(objective, lower, upper, linCons, control=list(solver=solver)) print(ans) } # NEOS: # require(rneos) neos <- rneosQP(objective, lower, upper, linCons, control=list(solver="ipopt", category="nco")) neos # nco: Using Nonlinear Constrained Optimization Solver: for (solver in c( "conopt", "filter", "knitro", "lancelot", "loqo", "minos", "mosek", "pennon", "snopt")) { ans <- rneosQP(objective, lower, upper, linCons, control=list(solver=solver, category="nco")) print(ans) } # KRESTREL: kestrel <- rkestrelQP(objective, lower, upper, linCons, control=list(solver="loqo")) kestrel } ############################################################################### fPortfolio/R/backtest-Plots.R0000644000175100001440000005217012330665056015651 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # backtestPlot Creates a summary of backtesting plots # backtestAssetsPlot Plots assets used in a portfolio backtest # backtestWeightsPlot Plots recommended weights from a backtest # backtestRebalancePlot Plots rebalanced weights of a backtest # backtestPortfolioPlot Plots benchmark and portfolio series # backtestDrawdownPlot Plots the drawdown of the portfolio backtest # backtestReportPlot Prints backtest report ################################################################################ backtestPlot <- function(object, which = "all", labels = TRUE, legend = TRUE, at = NULL, format = NULL, cex=0.6, font=1, family="mono") { # A function implemented by Diethelm Wuertz and William Chen # Description: # Creates a summary of backtesting plots # Arguments: # object - a list as returned by the function portfolioSmoothing() # which - which plots should be displayed # labels - a logical flag, should automated labels added to the plot # FUNCTION: # Frame: if (any(which == "all")) par(mfrow = c(3, 2), mar = c(1.5, 4, 5, 2), oma = c(5, 1, 0, 1)) # Plot: if(any(which == "1") || which == "all") backtestAssetsPlot (object, labels, legend, at, format) if(any(which == "2") || which == "all") backtestWeightsPlot (object, labels, legend, at, format) if(any(which == "3") || which == "all") backtestRebalancePlot (object, labels, legend, at, format) if(any(which == "4") || which == "all") backtestPortfolioPlot(object, labels, legend, at, format) if(any(which == "5") || which == "all") backtestDrawdownPlot(object, labels, legend, at, format) if(any(which == "6" )|| which == "all") backtestReportPlot(object, cex=cex, font=font, family=family) # Return Value: invisible() } # ------------------------------------------------------------------------------ # Plot 1: backtestAssetsPlot <- function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Plots assets used in a portfolio backtest # Arguments: # object - a list as returned by the function portfolioSmoothing() # labels - a logical flag, should automated labels added to the plot # FUNCTION: # Settings: data <- object$data benchmark <- object$benchmarkName assets <- object$assetsNames # Time Axis: if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-") if (is.null(format)) Format <- "%b/%y" else Format <- format # Labels ? if (labels) { main <- "Index Series" xlab <- "" ylab <- "Cumulated log Returns" } else { main <- "" xlab <- "" ylab <- "" } # Series: X <- data[, benchmark] # ylim - Plot Range: nAssets <- length(assets) MAX <- -1.0e99 for (i in 1:nAssets) MAX = max(c(MAX, cumsum(data[, assets[i]])) ) MAX <- max(MAX, cumsum(data[, benchmark])) MIN <- 1.0e99 for (i in 1:nAssets) MIN <- min(MIN, cumsum(data[, assets[i]])) MIN <- min(MIN, cumsum(data[, benchmark])) rangeY <- c(MIN, MAX) # xlim - Plot Range: xlim <- range(time(colCumsums(data[, benchmark]))) shift <- round(0.20 *as.integer(diff(xlim)), 0) * 24 * 60 * 60 rangeX <- c(round(xlim[1]-shift), xlim[2]) Days <- 1:as.integer(diff(xlim)) Time <- as.character(xlim[1] + Days*24*60*60) range.tS <- timeSeries(data = matrix(rep(0, length(Time))), as.character(Time)) # Limits: xlim <- rangeX ylim <- rangeY # Plot: plot(X, type = "n", xaxt = "n", at = at, format = Format, xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "") grid(NA, ny = NULL) abline(v = as.POSIXct(at), lty = 3, col = "brown") # Add Lines: lines(colCumsums(data[, benchmark]), col = "black") lines(colCumsums(data[, benchmark]), col = "black") for (i in 1:nAssets) lines( colCumsums(data[, assets[i]]), col = i+1) # Asset Names: Benchmark <- abbreviate(benchmark, 4) Assets <- abbreviate(assets, 4) assetsList <- c(Benchmark, Assets) assetsTitle <- paste(Benchmark, " ~ ", paste( Assets, collapse = " - ", sep = ""), sep="") # Add Title: if (labels) { title(main = main, xlab = xlab, ylab = ylab) } # Add Legend and Subtitle: if (legend) { mtext(assetsTitle, line = 0.5, cex = 0.7) legend("topleft", legend = assetsList, bty = "n", text.col = 1:(nAssets+1), cex = 0.8) } # Return Value: invisible() } # ------------------------------------------------------------------------------ # Plot 2: backtestWeightsPlot <- function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Plots recommended weights from a portfolio backtest # Arguments: # object - a list as returned by the function portfolioSmoothing() # labels - a logical flag, should automated labels added to the plot # FUNCTION: # Settings: data <- object$data weights <- object$smoothWeights assets <- object$assetsNames benchmark <- object$benchmarkName horizon <- getWindowsHorizon(object$backtest) smoothing <- getSmootherLambda(object$backtest) startup <- "1m" horizonLength = as.numeric(substr(horizon, 1, nchar(horizon)-1)) horizonUnit = substr(horizon, nchar(horizon), nchar(horizon)) stopifnot(horizonUnit == "m") # Time Axis: if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-") if (is.null(format)) Format <- "%b/%y" else Format <- format # Labels ? if (labels) { main <- "Weights Recommendation" xlab <- "" ylab <- "Asset Weights %" } else { main <- "" xlab <- "" ylab <- "" } # Series: X <- data[, benchmark] nAssets <- length(assets) naWeights <- matrix(rep(NA, times=horizonLength*nAssets), ncol=nAssets) # Lmits: xlim <- range(data) ylim <- c(0, 100) # Plot: plot(X, type = "n", xaxt = "n", las = 2, at = at, format = Format, xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "") grid(NA, ny = NULL) abline(v = as.POSIXct(at), lty = 3, col = "brown") # Add Lines: lines(X, col = "black") tS <- 100 * timeSeries(weights) for (i in 1:nAssets) lines(tS[, i], col = i+1) # Asset Names: Benchmark <- abbreviate(benchmark, 4) Assets <- abbreviate(assets, 4) assetsList <- c(Benchmark, Assets) assetsTitle <- paste(Benchmark, " ~ ", paste(Assets, collapse = " - ", sep = ""), sep="") # Add Title: if (labels) { title(main = main, xlab = xlab, ylab = ylab) text <- paste( "Horizon = ", horizon, "| Smoothing:", smoothing, "| Startup:", startup, "| Shift 1m") mtext(text, line = 0.5, cex = 0.7) } # Add Legend: if (legend) { legend("topleft", legend = assetsList, bty = "n", text.col = 1:(nAssets+1), cex = 0.8) } # Return Value: invisible() } # ------------------------------------------------------------------------------ # Plot 3: backtestRebalancePlot <- function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Plots rebalanced weights of a backtest # Arguments: # object - a list as returned by the function portfolioSmoothing() # labels - a logical flag, should automated labels added to the plot # FUNCTION: # Settings: data <- object$data weights <- object$smoothWeights assets <- object$assetsNames benchmark <- object$benchmarkName horizon <- getWindowsHorizon(object$backtest) smoothing <- getSmootherLambda(object$backtest) startup <- "1m" horizonLength <- as.numeric(substr(horizon, 1, nchar(horizon)-1)) horizonUnit <- substr(horizon, nchar(horizon), nchar(horizon)) stopifnot(horizonUnit == "m") horizon <- horizonLength # Time Axis: if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-") if (is.null(format)) Format <- "%b/%y" else Format <- format # Labels ? if (labels) { main <- "Weights Rebalance" xlab <- "" ylab <- "Weights Changes %" } else { main <- "" xlab <- "" ylab <- "" } # Series: X <- data[, benchmark] nAssets <- length(assets) naWeights <- matrix(rep(NA, times = horizon * nAssets), ncol = nAssets) naWeights <- rbind(naWeights, rep(NA, times = nAssets)) diffWeights <- rbind(naWeights, diff(weights)) absSum <- function(x) { sum(abs(x)) } diffWeights <- apply(diffWeights, 1, FUN = absSum) diffWeights <- cbind(diffWeights, rbind(naWeights, diff(weights))) tS <- 100 * timeSeries(diffWeights[-seq(horizon + 1),], charvec = rownames(diffWeights)[-seq(horizon + 1)]) # Limits: xlim <- range(time(data)) ylim <- range(tS) # Plot: plot(X, type = "n", xaxt = "n", las = 2, at = at, format = Format, xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "") grid(NA, ny = NULL) abline(v = as.POSIXct(at), lty = 3, col = "brown") abline(h=0, col="darkgrey") # Add Lines: # lines(X) lines(tS[, 1], type = "h", lwd = 1, col = "darkgrey") for (i in 2:NCOL(tS)) lines(tS[, i], col = i) # Asset Names: Benchmark <- abbreviate(benchmark, 4) Assets <- abbreviate(assets, 4) assetsList <- c(Benchmark, Assets) assetsTitle <- paste(Benchmark, " ~ ", paste(Assets, collapse = " - ", sep = ""), sep="") # Add Title: if (labels) { title(main = main, xlab = xlab, ylab = ylab) text <- paste( "Horizon = ", horizon, "| Smoothing:", smoothing, "| Startup:", startup, "| Shift 1m") mtext(text, line = 0.5, cex = 0.7) # mText = paste("Start:", rownames(object$smoothWeights)[1]) # mtext(mText, side = 4, line = 0, adj = 0, col = "darkgrey", cex = 0.65) } # Add Legend: if (legend) { legend("topleft", legend = assetsList, bty = "n", text.col = 1:(nAssets+1), cex = 0.8) } # Return Value: invisible() } # ------------------------------------------------------------------------------ # Plot 4: backtestPortfolioPlot <- function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Plots daily, benchmark and portfolio series of a portfolio backtest # Arguments: # object - a list as returned by the function portfolioSmoothing() # labels - a logical flag, should automated labels added to the plot # FUNCTION: # Settings: data <- object$data portfolioReturns <- object$portfolioReturns benchmarkReturns <- object$benchmarkReturns assets <- object$assetsNames benchmark <- object$benchmarkName horizon <- getWindowsHorizon(object$backtest) smoothing <- getSmootherLambda(object$backtest) startup <- "1m" offsetReturn <- object$offsetReturn # Time Axis: if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-") if (is.null(format)) Format <- "%b/%y" else Format <- format # Labels ? if (labels) { main <- "Portfolio vs Benchmark" xlab <- "" ylab <- "Cumulated log Returns" } else { main <- "" xlab <- "" ylab <- "" } # Series: X <- data[, benchmark] # Cumulated Return Series: cumX <- colCumsums(X) cumP <- portfolioReturns + offsetReturn cumB <- benchmarkReturns + offsetReturn offsetTS <- timeSeries(offsetReturn, charvec = names(offsetReturn), units = "offsetReturn") cumP <- rbind(offsetTS, cumP) cumB <- rbind(offsetTS, cumB) MAX <- max(as.vector(series(cumP)), as.vector(series(cumB)), as.vector(series(cumX))) MIN <- min(as.vector(series(cumP)), as.vector(series(cumB)), as.vector(series(cumX))) # Limits: xlim <- c(as.POSIXct(start(X)), as.POSIXct(end(X))) ylim <- c(MIN, MAX) # Plot: plot(X, type = "n", xaxt = "n", at = at, format = Format, xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "") grid(NA, ny = NULL) abline(v = as.POSIXct(at), lty = 3, col = "brown") abline(h=0, col="darkgrey") # Add Lines: lines(cumX, col = "black") lines(cumP-cumB, type = "h", col = "grey") lines(cumP, col = "red", lwd = 2) lines(cumB, col = "blue", lwd = 2) # Asset Names: Benchmark <- abbreviate(benchmark, 4) Assets <- abbreviate(assets, 4) assetsList <- c(Benchmark, Assets) assetsTitle <- paste(Benchmark, " ~ ", paste(Assets, collapse = " - ", sep = ""), sep="") nAssets <- length(assetsList) # Add Title: if (labels) { title(main = main, xlab = xlab, ylab = ylab) text <- paste( "Horizon = ", horizon, "| Smoothing:", smoothing, "| Startup:", startup, "| Shift 1m") mtext(text, line = 0.5, cex = 0.7) # mText <- Type = getType(object$spec) # Estimator <- getEstimator(object$spec) # if (Type == "MV") mText = paste(mText, "|", Estimator) # mtext(mText, side = 4, line = 0, adj = 0, col = "darkgrey", cex = 0.7) } # Add Legend: if (legend) { legend("topleft", legend = assetsList, bty = "n", text.col = 1:(nAssets+1), cex = 0.8) } # Return Value: invisible() } # ------------------------------------------------------------------------------ # Plot 5: backtestDrawdownPlot <- function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Creates Backtest Portfolio Plot # Arguments: # object - a list as returned by the function portfolioSmoothing() # labels - a logical flag, should automated labels added to the plot # FUNCTION: # Settings: data <- object$data assets <- object$assetsNames benchmark <- object$benchmarkName horizon <- getWindowsHorizon(object$backtest) smoothing <- getSmootherLambda(object$backtest) startup <- getSmootherInitialWeights(object$backtest) weights <- as.timeSeries(object$smoothWeights) # Align Data: Data <- .align.timeSeries(data)/100 # Time Axis: if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-") if (is.null(format)) Format <- "%b/%y" else Format <- format # Labels ? if (labels) { main <- "Portfolio vs Benchmark" xlab <- "" ylab <- "Drawdown" } else { main <- "" xlab <- "" ylab <- "" } # Extract the Time Stamps: tS <- time(Data) tW <- time(weights) # Problem when rebalance day lands on a Weekend - # need to change the date to the nearest Monday if (any(isWeekend(tW))){ weekend.tW <- tW[isWeekend(tW)] # WC: check timeNdayOnOrAfter function, the nday = 2 is a Monday!??? tW <- sort(c(tW[!isWeekend(tW)], timeNdayOnOrAfter(weekend.tW, 2))) # replace old times with new times time(weights) <- tW } # Extract the Updated Revalance Dates: Dates <- time(weights) # Subsetting the Data: data <- window(Data, start(weights), end(weights)) # Check whether we have data past the last balance date # i.e. last balance date won't take place if we don't have the return series if (end(data) < end(weights)){ n <- length(Dates)-1 } else {n = length(Dates) Dates <- c(Dates, end(data)) } # Calculate the portfolio returns for the given weights: # assume we start investing the new weights on the rebalance date pf <- NULL a <- NULL for (i in 1:n){ temp <- window(data, Dates[i], Dates[i+1])[,assets] nr <- nrow(temp) if (i != n) temp = temp[-nr,] a <- c(a, nrow(temp)) pf <- c(pf, pfolioReturn(temp, as.numeric(weights[i,]))) } # Drawdown Plot Settings: stopifnot(length(pf) == length(rownames(data))) pf <- timeSeries(pf, charvec = rownames(data)) pf.DD <- drawdowns(pf) benchmark.DD <- drawdowns(data[,benchmark]) # Series: X <- Data[, benchmark] # Limits: xlim <- c(as.POSIXct(start(X)), as.POSIXct(end(X))) ylim <- range(c(pf.DD, benchmark.DD)) # Plot: plot(X, type = "n", xaxt = "n", at = at, format = Format, xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "") grid(NA, ny = NULL) abline(v = as.POSIXct(at), lty = 3, col = "brown") # Add Lines: lines(benchmark.DD, col = "blue", lwd = 2) lines(pf.DD, col = "red", lwd = 2) # Asset Names: Benchmark <- abbreviate(benchmark, 4) Assets <- abbreviate(assets, 4) assetsList <- c(Benchmark, Assets) assetsTitle <- paste(Benchmark, " ~ ", paste(Assets, collapse = " - ", sep = ""), sep="") # Add Title: if (labels) { title(main = main, xlab = xlab, ylab = ylab) text <- paste("(Max)", "Portfolio DD =", round(min(pf.DD),2), "|", "Benchmark DD =", round(min(benchmark.DD),2)) mtext(text, line = 0.5, cex = 0.7) } # Add Legend: if (legend) { legend("bottomleft", legend = c("Benchmark", "Portfolio"), bty = "n", text.col = c("blue", "red"), cex = 0.8) } # Return Value: invisible() } # ------------------------------------------------------------------------------ # Plot 6 - Report: backtestReportPlot <- function(object, cex=0.6, font=1, family="mono") { # A function implemented by Diethelm Wuertz and William Chen # Description: # Prints backtest report as graphical plot # Arguments: # object - a list as returned by the function portfolioSmoothing() # FUNCTION: # Settings: CEX <- cex # Start Plot: plot.new() plot.window(xlim = c(0, 1), ylim = c(0, 1)) # Vertical Adjustment: z <- -2 TEXT <- paste("Strategy:", getStrategyFun(object$backtest)) mtext(TEXT, side = 3, line = z + 3, adj = 0, font=2, family="sans", cex=CEX) TEXT <- capture.output(round(object$stats, 2)) mtext(TEXT[1], side = 3, line = z + +2, adj = 0, font=font, family="mono", cex=CEX) mtext(TEXT[2], side = 3, line = z + +1, adj = 0, font=font, family="mono", cex=CEX) mtext(TEXT[3], side = 3, line = z + +0, adj = 0, font=font, family="mono", cex=CEX) mtext(TEXT[4], side = 3, line = z + -1, adj = 0, font=font, family="mono", cex=CEX) mtext(TEXT[5], side = 3, line = z + -2, adj = 0, font=font, family="mono", cex=CEX) TEXT <- capture.output(object$spec)[c(2,3,4,5,8)] mtext("Portfolio Specification:", side = 3, line = z + -4, adj = 0, font=2, family="sans", cex=CEX) if (length(grep("CVaR",TEXT[2]))!=0) TEXT[2] = gsub("CVaR", paste("CVaR |", getAlpha(object$spec)), TEXT[2]) mtext(TEXT[2], side = 3, line = z + -5, adj = 0, font=font, family=family, cex=CEX) mtext(TEXT[3], side = 3, line = z + -6, adj = 0, font=font, family=family, cex=CEX) mtext(TEXT[4], side = 3, line = z + -7, adj = 0, font=font, family=family, cex=CEX) #text(TEXT[5], side = 3, line = z + -8, adj = 0, font=font, family=family, cex=CEX) TEXT <- capture.output(object$constraints)[1] mtext("Constraints:", side = 3, line = z + -9, adj = 0, font=2, family="sans", cex=CEX) TEXT <- substr(TEXT[1], 4, 99) mtext(TEXT, side = 3, line = z + -10, adj = 0, font=font, family=family, cex=CEX) # Return Value: invisible() } ################################################################################ fPortfolio/R/mathprogNLP-ampl.R0000644000175100001440000001264612323217770016076 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # ramplNLP Rmetrics Interface for AMPL LP solvers # amplNLP Convenience wrapper for AMPL LP solvers # amplControl AMPL LP control parameter list ################################################################################ ramplNLP <- function( start, objective, lower=0, upper=1, amplCons, control=list(), ...) { # A function implemented by Diethelm Wuertz # FUNCTION: # Control List: ctrl = amplNLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control = ctrl # General Settings: if (length(start) == 1) { n = start } else { n = length(start) } # Box Constraints: if(length(lower) == 1) { par.lower = rep(lower, n) } else { par.lower = lower } if(length(upper) == 1) { par.upper = rep(upper, n) } else { par.upper = upper } # Controls: solver = control$solver project = control$project trace = control$trace # Add dots ... args <- list(...) m1 = names(match.call(expand.dots = TRUE)) m2 = names(match.call(expand.dots = FALSE)) Names = m1[!(m1 %in% m2)] amplDataOpen(project) amplDataAdd("n", data = n, type = "value", project) amplModelOpen(project) amplModelAdd("param n ;", project) count = 0 for (a in args) { count = count + 1 if(length(a) == 1) { type = "value" } else { if(is.matrix(a)) { type = "matrix" } else { type = "vector" } } if (type == "value") amplModelAdd(paste("param ", Names[count], ";", sep = ""), project) if (type == "vector") amplModelAdd(paste("param ", Names[count], "{1 ..", length(a), "};", sep = ""), project) if (type == "matrix") amplModelAdd(paste("param ", Names[count], "{1..", NCOL(a), ", 1..", NROW(a), "}", ";", sep=""), project) amplDataAdd(Names[count], data = a, type = type, project) } amplModelAdd(paste("param lower {1..", length(par.lower), "};", sep = ""), project) amplModelAdd(paste("param upper {1..", length(par.upper), "};", sep = ""), project) amplDataAdd("lower", data = par.lower, type = "vector", project) amplDataAdd("upper", data = par.upper, type = "vector", project) if(trace) amplDataShow(project) # Add Objective: amplModelAdd("var x{1..n} ;", project) amplModelAdd(paste( "minimize Function: ", objective, sep = ""), project) amplModelAdd(amplCons, project) if(trace) amplModelShow(project) # Write Run File: solver = "ipopt" amplRunOpen(project) run <- c( "reset ;", paste("option solver ", solver, " ;", sep = ""), paste("model ", project, ".mod ;", sep = ""), paste("data ", project, ".dat ;", sep = ""), "solve ;", paste("display x > ", project, ".txt ;", sep = ""), "exit ;") amplRunAdd(run, project) if(trace) amplRunShow(project) # AMPL: command = paste("ampl", paste(project, "run", sep=".")) solve = system(command, show.output.on.console = TRUE) # Read Result: file <- paste(project, "txt", sep = ".") ans = scan(file, what = character()) ans = matrix(as.numeric(ans[-c(1:3, length(ans))]), byrow=TRUE, ncol = 2) index = sort(ans[,1], index.return = TRUE)$ix solution = ans[index, 2] # Return Value: value <- list( opt = args, solution = solution, objective = NA, status = NA, message = "none", solver = "amplNLP") class(value) = c("solver", "list") value } # ----------------------------------------------------------------------------- amplNLP <- function() { # A function implemented by Diethelm Wuertz # FUNCTION: NA } ############################################################################### amplNLPControl <- function(solver = "minos", project = "ampl", trace = FALSE) { # A function implemented by Diethelm Wuertz # FUNCTION: # Control Parameters: control <- list( solver = solver, project = project, trace = trace) # Return Value: control } ############################################################################### fPortfolio/R/monitor-stability.R0000644000175100001440000006267713202336404016447 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # stabilityAnalytics Retroactive stability analytics # FUNCTION: DESCRIPTION: # turnsAnalytics Retroactive turning point analytics # drawdownsAnalytics Retroactive maximum drawdown analytics # garchAnalytics Retroactive Garch volatility analytics # riskmetricsAnalytics Retroactive Riskmetrics analytics # bcpAnalytics Retroactive Bayesian changepoints analytics # pcoutAnalytics Retroactive Principal component outlier analytics # FUNCTION: DESCRIPTION: # addRainbow Adds rainbow colored stability indicators # FUNCTION: DESCRIPTION: # waveletSpectrum Retroactive Morlet wavelet analytics # FUNCTION: DESCRIPTION: # parAnalytics Graph frame settings for a desired analytics ############################################################################### stabilityAnalytics <- function(index, method=c("turns", "drawdowns", "garch", "riskmetrics", "bcp", "pcout"), ...) { # A function implemented by Diethelm Wuertz and Tobias Setz # Description: # Retroactive stability analytics # FUNCTION: # Run Analytics: method <- match.arg(method) FUN <- paste(method, "Analytics", sep = "") fun <- match.fun(FUN) # Return Value: fun(index, ...) } ############################################################################### turnsAnalytics <- function(index, spar=0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="%m/%y") { # A function implemented by Diethelm Wuertz and Tobias Setz # Description: # Retroactive Turning Points Analytics # Arguments: # index - an index or price S4 'timeSeries' object # spar - a numeric between 0 and, the degree of smoothness # main - main plot title # trace - a logical, should the results be traced? # plot - a logical, should the results be plotted # at - generate pretty axis positions # format - a string describing the label format # Note: # The lowess and supsmu smoothers are by far not as good as the # spline smoother. # FUNCTION: # Settings: stopifnot(isUnivariate(index)) if (is.null(main)) main <- "Retroactive Turnpoints Analytics" # Smooth Return Series: rets <- returns(index) indexSmu <- smoothSpline(log(index), spar=spar) # Turnpoints: warn <- getOption("warn") options(warn=-1) indexTurns <- turns(indexSmu[, 2]) options(warn=warn) indexTurns <- indexTurns[indexTurns[, 2] !=0, ] # Add Verical Lines: turns.tps <- format(time(indexTurns)) n.tps <- length(turns.tps) # Trace Results: if (trace){ cat("Series:\n", colnames(index), "\n") cat("Turning Points:", n.tps, "\n") print(turns.tps) } # Positions: positions <- sign(returns(exp(indexSmu[, 2]), trim=FALSE)) positions[1, 1] <- 0 ablines <- time(positions)[as.vector(positions) < 0] # Plot: if (doplot) { # Turnpoints: range <- range(log(index)) ylim <- c(range[1], range[2] + diff(range(log(index)))/4) plot(indexSmu[, 1], ylim=ylim, main="", ylab="", xlab="", las=2, at=at, format=format, col="black") title(main=main, ylab=paste("log Index", colnames(index)), xlab="") abline(v=ablines, lty=3, lwd=2, col="steelblue") lines(indexSmu[, 1], col="black") lines(indexSmu[, 2], col="red") if (turns.tps[2] > 0) points(indexTurns[, 1], pch=19, col="red") abline(v=as.POSIXct(at), col="darkgrey", lty=3) box(col="white") box(bty="l") # Add Returns: center <- range[2] + diff(range(log(index)))/4/2 scale <- diff(range(log(index)))/4 returnsScaled <- (rets-mean(rets))/max(abs(rets)) * scale/2 + center lines(returnsScaled, col="orange") abline(h=mean(returnsScaled), col="darkgrey", lty=3) box(col="white") box(bty="l") # Add Rmwtrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") } # Check Turnpoints: if ( turns.tps[1] == "1" & turns.tps[2] == "0") n.tps <- 0 # Return Value: invisible(list( data=indexSmu, turns=turns.tps, positions=positions, ablines=ablines, n=n.tps, smooth=spar)) } ############################################################################### drawdownsAnalytics <- function(index, spar=0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="%m/%y") { # A function implemented by Diethelm Wuertz and Tobias Setz # Description: # Retroactive Maximum Drawdown Analytics # Arguments: # index - an index or price S4 'timeSeries' object # spar - a numeric between 0 and, the degree of smoothness # main - main plot title # trace - a logical, should the results be traced? # plot - a logical, should the results be plotted # at - generate pretty axis positions # format - a string describing the label format # FUNCTION: # Settings: stopifnot(isUnivariate(index)) if (is.null(main)) main <- "Retroactive Drawdowns Analytics" # Series: rets<- returns(index) # Turning Points: tps <- turnsAnalytics(index=index, spar=spar, trace=trace, doplot=FALSE) ablines <- tps$ablines # Drawdowns: maxdd <- drawdowns(rets) # Plot: if(doplot) { # Plot: plot(maxdd, main=main, xlab="", ylab=paste("Drawdwons", colnames(index)), las=2, at=at, format=format) abline(v=ablines, lty=3, lwd=2, col="steelblue") lines(maxdd) box(col="white") box(bty="l") # Add Rmwtrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") } # Return Value: invisible(list( index = index, series = maxdd)) } ############################################################################### garchAnalytics <- function (index, spar = 0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="%m/%y") { # A function implemented by Diethelm Wuertz and Tobias Setz # Arguments: # index - an index or price S4 'timeSeries' object # spar - a numeric between 0 and, the degree of smoothness # main - main plot title # trace - a logical, should the results be traced? # plot - a logical, should the results be plotted # at - generate pretty axis positions # format - a string describing the label format # Description: # Retroactive Garch11 Volatility Analytics # FUNCTION: # Load Library: # require(fGarch) # Settings: stopifnot(isUnivariate(index)) if (is.null(main)) main <- "Retroactive Garch Analytics" # Fit Garch11 Model: fit <- fGarch::garchFit(data = 100 * returns(index), trace=trace) xseries <- as.timeSeries(fit@data)/100 Index <- cumulated(xseries) colnames(Index) <- colnames(index) # Turning Points: tps <- turnsAnalytics(index=index, spar=spar, trace=trace, doplot=FALSE) ablines <- tps$ablines # Plot Return Series and Standard Deviations: xcsd <- timeSeries(data = fit@sigma.t/100, charvec = time(xseries)) if (doplot) { # Plot: sdPlus <- mean(xseries) + 2 * xcsd sdMinus <- mean(xseries) - 2 * xcsd range <- range(xseries, sdPlus, sdMinus) plot(xseries, main=main, xlab="", ylab=paste("Volatility", colnames(index)), at=at, format=format, # type="l", col="steelblue", ylim=range) abline(v = ablines, lty = 3, lwd = 2, col = "grey") lines(xseries, col = "steelblue") lines(sdPlus, col = "red", lwd = 2) lines(sdMinus, col = "red", lwd = 2) abline(h = 0, col = "grey", lty = 3) box(col = "white") box(bty = "l") # Margin Text: # mtext("Volatility Band: 2 sd", adj = 0, side = 4, cex = 0.7, # col = "darkgrey") # Add Rmwtrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") } # Return Value: invisible(list( index = index, residuals = xseries, volatility = xcsd, fit = fit)) } ############################################################################### riskmetricsAnalytics <- function(index, spar=0.5, lambda=0.9, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="%m/%y") { # A function implemented by Diethelm Wuertz and Tobias Setz # Description: # Retroactive riskmetrics analytics # Arguments: # index - an index or price S4 'timeSeries' object # spar - a numeric between 0 and, the degree of smoothness # main - main plot title # trace - a logical, should the results be traced? # plot - a logical, should the results be plotted # at - generate pretty axis positions # format - a string describing the label format # FUNCTION: # Settings: stopifnot(isUnivariate(index)) if (is.null(main)) main <- "Retroactive RiskMetrics Analytics" # Series: rets <- returns(index) # Turning Points: tps <- turnsAnalytics(index=index, spar=spar, trace=trace, doplot=FALSE) ablines <- tps$ablines # Indicator: sigma <- .emaIndicator(abs(rets), lambda) sd <- sqrt(.emaIndicator(rets^2, lambda)) # Plot: if(doplot) { # Plot: sdPlus <- mean(rets) + 2 * sd sdMinus <- mean(rets) - 2 * sd range <- range(rets, sdPlus, sdMinus) plot(rets, main="", xlab="", ylab=paste("Volatility", colnames(index)), at=at, format=format, ylim=range) abline(v=ablines, lty=3, lwd=2, col="grey") lines(rets, col="steelblue") lines(mean(rets) + 2*sd, col="orange", lwd=2) lines(mean(rets) - 2*sd, col="orange", lwd=2) lines(mean(rets) + 2*sigma, col="red", lwd=2) lines(mean(rets) - 2*sigma, col="red", lwd=2) abline(h=0, col="grey", lty=3) box(col="white") box(bty="l") # Margin Text: # mtext(paste("sd/var Volatility Bands: 2 sd | lambda", lambda), # adj=0, side=4, cex=0.7, col="darkgrey") # Add Rmwtrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") } # Return Value: invisible(list( index = index, analytics = sigma)) } ############################################################################### bcpAnalytics <- function (index, spar=0.5, FUN=returns, method=c("prob", "mean", "var"), main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="%m/%y") { # A function implemented by Diethelm Wuertz and Tobias Setz # Description: # Retroactive Bayesian Change Points Analytics # Arguments: # index - an index or price S4 'timeSeries' object # spar - a numeric between 0 and, the degree of smoothness # main - main plot title # trace - a logical, should the results be traced? # plot - a logical, should the results be plotted # at - generate pretty axis positions # format - a string describing the label format # FUNCTION: # Load Library: # require(bcp) # Settings: stopifnot(isUnivariate(index)) if (is.null(main)) main <- "Retroactive Change Points Analytics" # Turning Points: tps <- turnsAnalytics(index=index, spar=spar, trace=trace, doplot=FALSE) positions <- tps$positions ablines <- tps$ablines # BCP Analytics: fun <- match.fun(FUN) series <- fun(index) analytics <- bcp::bcp(series) # Compose Series: method <- match.arg(method) select <- c(mean="posterior.mean", var="posterior.var", prob="posterior.prob") series(series) <- analytics[[select[method]]] # Compose y-axis Label: ylab <- c(mean="Mean", var="Variance", prob="Probability") ylab <- paste("Posterior", ylab[method], colnames(index)) # Select: if (method == "prob") { ylim <- c(0, 1) prob <- timeSeries(data=analytics$posterior.prob, charvec=time(series)) prob <- na.omit(prob) } else { ylim <- range(na.omit(series)) prob <- NA } # Plot: if (doplot) { # Plot: plot(series, type="h", ylim=ylim, las=2, col="grey", main=main, xlab="", ylab=ylab, at=at, format=format) abline(v=ablines, lty=3, lwd=2, col="steelblue") points(series, pch=19, cex=0.5) box(col = "white") box(bty = "l") # MarginText: # mtext(paste("Smooth:", spar), adj = 0, side = 4, cex = 0.7, col = "darkgrey") # Add Rmwtrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") } # Return Value: invisible(list( index = index, analytics = analytics, prob = prob)) } ############################################################################### pcoutAnalytics <- function (index, spar=0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="%m/%y", strong=TRUE, k=2, cs=0.25, outbound=0.25) { # A function implemented by Diethelm Wuertz and Tobias Setz # Description: # Retroactive PCA outlier analytics # Arguments: # index - an index or price S4 'timeSeries' object # spar - a numeric between 0 and, the degree of smoothness # main - main plot title # trace - a logical, should the results be traced? # plot - a logical, should the results be plotted # at - generate pretty axis positions # format - a string describing the label format # FUNCTION: # Load Library: # require(mvoutlier) # Settings: stopifnot(isUnivariate(index)) if (is.null(main)) main <- "Retroactive Outlier Analytics" # Turning Points: tps <- turnsAnalytics(index=index, spar=spar, trace=trace, doplot=FALSE) positions <- tps$positions ablines <- tps$ablines # Series Settings: X <- log(index) Y <- returns(index) Z <- cbind(X[-1, ], Y) u <- Y v <- lag(u, k=-k:k, trim=TRUE) U <- u[time(v), ] # Principal Component Outlier Analytics: ans <- mvoutlier::pcout(v, makeplot=FALSE, explvar=0.99, crit.M1=1/3, crit.c1=2.5, crit.M2=1/4, crit.c2=0.99, cs=cs, outbound=outbound) # Plot: colnames(X) <- paste(colnames(X), "X", sep=":") colnames(Y) <- paste(colnames(Y), "Y", sep=":") Z <- cbind(X[time(v), ], Y[time(v), ]) Z@recordIDs <- data.frame(wfinal01=ans$wfinal01, wfinal=ans$wfinal, wloc=ans$wloc, wscat=ans$wscat, x.dist1=ans$x.dist1, x.dist2=ans$x.dist2) rownames(Z@recordIDs) <- rownames(Z) wfinal01 <- ans$wfinal01 if (strong) { V <- as.timeSeries(Z@recordIDs)[, "wfinal01"] W <- lag(V, k=k, trim=TRUE) S <- timeSeries(data=rowSums(W)) Sfinal <- S == 0 z <- timeSeries(charvec=time(Z), data=ans$wfinal01) z[time(S), ] <- as.integer(!Sfinal) wfinal01 <- as.numeric(z) Z@recordIDs[, "wfinal01"] <- wfinal01 } ans$wfinal <- ans$wfinal01 <- ans$wloc <- ans$wscat <- NULL ans$x.dist1 <- ans$x.dist2 <- NULL U <- Z[, 1] wfinal01 <- Z@recordIDs$wfinal01 datapoints <- length(U) U <- Z[, 2] outliers <- length(U) - sum(wfinal01) percent <- round(100 * outliers/length(U), 2) weights <- as.timeSeries(Z@recordIDs)[, "wfinal"] # Analytics: Indicator <- 1 - weights invWeights <- as.vector(Indicator) extreme = sum(invWeights[invWeights > 0.75]) / length(invWeights) analytics <- c( mean = mean(1-weights), sd = sd(1-weights), extreme75 = extreme, indicator = Indicator) ylab <- paste("PC Outlier Prob", colnames(index)) # Plot: if(doplot) { # Plot: plot(Indicator, type="h", ylim=c(0, 1), las=2, col="grey", main=main, xlab="", ylab=ylab, at=at, format=format) abline(v=ablines, lty=3, lwd=2, col="steelblue") points(Indicator, pch=19, cex=0.5) # Add Grid and Box: grid(NA, ny=NULL) box(col="white") box(bty="l") # Margin Text: # mtext(paste("Smooth:", spar), adj=0, side=4, cex=0.7, col="darkgrey") # Add Rmetrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") } # Return Value: ans <- invisible(list( index = index, pcout = ans, series = Z, analytics = analytics, prob = Indicator)) class(ans) <- c("analytics", "list") ans } # ----------------------------------------------------------------------------- addRainbow <- function(analytics, palette=rainbow, a=0.3, b=0.8, K=100) { # A function implemented by Diethelm Wuertz and Tobias Setz # Example: # analytics <- pcoutAnalytics(index); addRainbow(analytics) # analytics <- bcpAnalytics(index); addRainbow(analytics) # FUNCTION: # Get Probability Indicator: Indicator <- analytics$prob # Check: stopifnot(isUnivariate(Indicator)) stopifnot(min(Indicator) >= 0) stopifnot(max(Indicator) <= 1) # Add Spline Smoothed Indicators: k.spar <- seq(a, b, length=K) for (k in 1:K) { curve <- timeSeries::smoothSpline(Indicator, spar=k.spar[k])[, 2] if (k == 1) curve1 <- curve if (k == K) diff <- curve - curve1 lines(curve, lwd=2, col=palette(K)[k]) } # Add Difference Indicator Line: lines(diff + 0.5, lwd=2) abline(h=0.5, lwd=2, col="orange") # Return Value: invisible() } ############################################################################### waveletSpectrum <- function(index, spar=0.5, main=NULL, trace=TRUE, doplot=TRUE, at=pretty(index), format="%m/%y") { # A function implemented by Diethelm Wuertz and Tobias Setz # Description: # Morlet Wavelet Analytics # Arguments: # index - an index or price S4 'timeSeries' object # spar - a numeric between 0 and, the degree of smoothness # main - main plot title # trace - a logical, should the results be traced? # plot - a logical, should the results be plotted # at - generate pretty axis positions # format - a string describing the label format # FUNCTION: # Load Library: # require(dplR) # Settings: stopifnot(isUnivariate(index)) if (is.null(main)) main <- "Morlet Wavelet Spectrum" # Index Returns: returns <- returns(index) Time <- 2:length(index) Returns <- as.vector(returns) ans <- dplR::morlet(y1=returns, x1=Time) # Returns a list containing: # y Numeric. The original time series. # x Numeric. The time values. # wave Complex. The wavelet transform. # coi Numeric. The cone of influence. # period Numeric. The period. # Scale Numeric. The scale. # Signif Numeric. The significant values. # Power Numeric. The squared power. # Turning Points: tps <- turnsAnalytics(index=index, spar=spar, trace=trace, doplot=FALSE) # Wavelet Spectrum: p <- as.vector(ans$Power) vec <- c(mean=mean(p), sd=sd(p), skew=skewness(p), kurt=kurtosis(p)) mat <- c( O = base::norm(ans$Power, "O"), # "One Norm" I = base::norm(ans$Power, "I"), # "Inf Norm" F = base::norm(ans$Power, "F"), # "Frobenius" M = base::norm(ans$Power, "M")) # "Max Modulus" if (trace) { cat("Stats Measures:\n") print(vec) print(mat) } analytics <- c(vec, mat) # Wavelet Parameters: wave.list <- ans wavelet.levels <- quantile(wave.list$Power, probs=seq(from=0, to=1, by=0.1)) add.coi <- TRUE add.sig <- TRUE crn.lab <- "RWI" key.cols <- rev(heat.colors(length(wavelet.levels))) key.lab <- expression(paste("Power"^2)) nyrs=NULL crn.col <- "black" crn.lwd <- 1 crn.ylim <- range(wave.list$y) * 1.1 # Settings: y <- wave.list$y x <- wave.list$x wave <- wave.list$wave period <- wave.list$period Signif <- wave.list$Signif coi <- wave.list$coi coi[coi == 0] <- 1e-12 Power <- wave.list$Power siglvl <- wave.list$siglvl Signif <- t(matrix(Signif, dim(wave)[2], dim(wave)[1])) Signif <- Power/Signif period2 <- log(period)/log(2) ytick <- unique(trunc(period2)) ytickv <- 2^(ytick) coi2 <- log(coi)/log(2) coi2[coi2 < 0] <- 0 coi2.yy <- c(coi2, rep(max(period2, na.rm=TRUE), length(coi2))) coi2.yy[is.na(coi2.yy)] <- coi[2] yr.vec.xx <- c(x, rev(x)) # DW # par.orig <- par(c("mar", "las", "mfrow")) # on.exit(par(par.orig)) nlevels <- length(wavelet.levels) key.labs <- formatC(wavelet.levels, digits=4, format="f") asp <- NA las <- 1 xlim <- range(x, finite=TRUE) ylim <- range(period2, finite=TRUE) ylim[2] <- ylim[2] * 1.1 # Image Plot: # DW # ... now you can create more than one plot on one page # plot.new() # plot.window(xlim, ylim, xaxs="r", yaxs="r") # Use instead: plot(xlim, ylim, xaxs = "r", yaxs = "r", col = "white", axes=FALSE, frame=FALSE, ann=FALSE) # DW # .Internal(filledcontour()) no longer works on 3.0. # .Internal(filledcontour( # as.double(x), as.double(period2), Power, # as.double(wavelet.levels), col=key.cols)) # Use instead: graphics::.filled.contour( x = as.double(x), y = as.double(period2), z = Power, levels = as.double(wavelet.levels), col = key.cols) title(main=main, xlab="", ylab=paste("Period", colnames(index))) box(col="white") box(bty="l") # Add Contours: contour(x, period2, Signif, levels=1, labels=siglvl, drawlabels=FALSE, axes=FALSE, frame.plot=FALSE, add=TRUE, lwd=2, col="black") # Add Coin of Influence: polygon(yr.vec.xx, coi2.yy, density=c(10, 20), angle=c(-45, 45), col="black") # Add Axis Labels: xtick <- NULL for (i in 1:length(time(index))) xtick <- c(xtick, which.min(abs(time(index) - at[i]))) axis(1, at=xtick, labels=format(at, format=format)) axis(2, at=ytick, labels=ytickv, las=2) # Add Scale Legend: nCol<- length(key.cols) positions <- seq(min(x), max(x), length=nCol+1) colLevels <- paste(signif(wavelet.levels,2)) for (i in 1:nCol) { lines(x=c(positions[i], positions[i+1]), y=c(1.03,1.03)*max(period2), lwd=3, col=key.cols[i]) text(x=(positions[i]+positions[i+1])/2, 1.07*max(period2), colLevels[i], cex=0.6) } points(positions, rep(1.03*max(period2), length=nCol+1), pch=19, cex=0.7) # Add Rmetrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") # Return Value: invisible(list( index = index, spar = spar, wavelet = ans, analytics = list(Time=x, Period=period2, Power=Power))) } ############################################################################### parAnalytics <- function() { # A function implemented by Diethelm Wuertz and Tobias Setz # Description: # Sets the graph frame for an analytics chart # FUNCTION: # Graph Frame: par(mfrow = c(2, 1)) par(mar = c(2, 4, 2, 2) + 0.1) par(omi = 0.2*c(1, 0.7, 1, 0.7)) # Return Value: invisible() } ############################################################################### fPortfolio/R/mathprogNLP-donlp2.R0000644000175100001440000002177112410276126016337 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # rdonlp2NLP Rmetrics Interface for DONLP2 LP sol # donlp2NLP Convenience wrapper for DONLP2 LP so # donlp2NLPControl DONLP2 LP control parameter list # rdonlp2 Synonyme name for Rdonlp2::donlp2 function ################################################################################ rdonlp2NLP <- function( start, objective, lower=0, upper=1, linCons, funCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Function wrapper for solver donlp2() # FUNCTION: # Update Control List: ctrl <- donlp2NLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl N <- length(start) # Box Constraints: if(length(lower) == 1) { par.lower <- rep(lower, N) } else { par.lower <- lower } if(length(upper) == 1) { par.upper <- rep(upper, N) } else { par.upper <- upper } # Linear Constraints: if(missing(linCons)) { eqA <- ineqA <- NULL eqA.bound <- ineqA.lower <- ineqA.upper <- NULL } else { mat <- linCons[[1]] lower <- linCons[[2]] upper <- linCons[[3]] eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) if (length(eqIndex) == 0) { eqA <- NULL eqA.bound <- NULL } else { eqA <- mat[eqIndex, ] eqA.bound <- lower[eqIndex] } if (length(ineqIndex) == 0) { ineqA <- NULL ineqA.lower <- NULL ineqA.upper <- NULL } else { ineqA <- mat[ineqIndex, ] ineqA.lower <- lower[ineqIndex] ineqA.upper <- upper[ineqIndex] } } # Nonlinear Constraints: if(missing(funCons)) { eqFun <- ineqFun <- list() eqFun.bound <- ineqFun.lower <- ineqFun.upper <- NULL } else { fun <- funCons[[1]] lower <- funCons[[2]] upper <- funCons[[3]] eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) if (length(eqIndex) == 0) { eqFun <- list() eqFun.boud <- NULL } else { eqFun <- fun[eqIndex] eqFun.bound <- lower[eqIndex] } if (length(ineqIndex) == 0) { ineqFun <- list() ineqFun.lower <- NULL ineqFun.upper <- NULL } else { ineqFun <- fun[ineqIndex] ineqFun.lower <- lower[ineqIndex] ineqFun.upper <- upper[ineqIndex] } } # Optimize Portfolio: optim <- donlp2NLP( start = start, objective = objective, par.lower = par.lower, par.upper = par.upper, eqA = eqA, eqA.bound = eqA.bound, ineqA = ineqA, ineqA.lower = ineqA.lower, ineqA.upper = ineqA.upper, eqFun = eqFun, eqFun.bound = eqFun.bound, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper, control = control) # Return Value: value = list( opt = optim, solution = optim$solution, objective = objective(optim$solution)[[1]], status = optim$status, message = optim$message, solver = "donlp2NLP") class(value) <- c("solver", "list") value } ################################################################################ donlp2NLP <- function( start, objective, par.lower = NULL, par.upper = NULL, eqA = NULL, eqA.bound = NULL, ineqA = NULL, ineqA.lower = NULL, ineqA.upper = NULL, eqFun = list(), eqFun.bound = NULL, ineqFun = list(), ineqFun.lower = NULL, ineqFun.upper = NULL, control = list()) { # A function implemented by Diethelm Wuertz # Description: # NLP wrapper for solver donlp2 # FUNCTION: # Environment: env <- .GlobalEnv # Update Control List: ctrl <- donlp2NLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] <- control[name] control <- ctrl # Set Box Constraints: if (is.null(par.lower)) par.lower <- rep(-Inf, length(start)) if (is.null(par.upper)) par.upper <- rep(+Inf, length(start)) if (length(par.lower) == 1) par.lower <- rep(par.lower, length(start)) if (length(par.upper) == 1) par.upper <- rep(par.upper, length(start)) # Set Linear Equality and Inequality Constraints: A <- rbind(eqA, ineqA) lin.lower <- c(eqA.bound, ineqA.lower) lin.upper <- c(eqA.bound, ineqA.upper) # Set Nonlinear Equality and Inequality Constraints: if ((length(eqFun) + length(ineqFun)) == 0) { nlin <- list() nlin.lower <- rep(-Inf, length(nlin)) nlin.upper <- rep(+Inf, length(nlin)) } else { nlin <- list() if (length(eqFun) > 0) nlin = c(nlin, eqFun) if (length(ineqFun) > 0) nlin = c(nlin, ineqFun) nlin.lower <- c(eqFun.bound, ineqFun.lower) nlin.upper <- c(eqFun.bound, ineqFun.upper) } # Optimize Portfolio: optim <- rdonlp2( par = start, fn = objective, par.upper = par.upper, par.lower = par.lower, A = A, lin.upper = lin.upper, lin.lower = lin.lower, nlin = nlin, nlin.upper = nlin.upper, nlin.lower = nlin.lower, control = control, control.fun = function(lst) {return(TRUE)}, env = .GlobalEnv, name = NULL) names(optim$par) <- names(start) # Extract Weights: weights <- .checkWeights(optim$par) attr(weights, "invest") <- sum(weights) # Check Messages and Get Status: # ... unfortunately donlp2 has no status vaqriable, # so we have to analyze the messages Status <- 1 # Message <- "1234567890123456789012345" message11 <- "KT-conditions satisfied, " # no further correction computed" message12 <- "computed correction small" # , regular case" message13 <- "stepsizeselection: x almo" # st feasible, dir. deriv. very small" if (substr(optim$message, 1, 25) == message11) Status <- 0 if (substr(optim$message, 1, 25) == message12) Status <- 0 if (substr(optim$message, 1, 25) == message13) Status <- 0 # Return Value: value <- list( opt = optim, solution = optim$par, objective = objective(optim$par)[[1]], status = Status, message = optim$message, solver = "donlp2NLP") class(value) <- c("solver", "list") value } ################################################################################ rdonlp2 <- function(...) { Rdonlp2::donlp2(...) } ################################################################################ donlp2NLPControl <- function ( iterma = 4000, nstep = 20, fnscale = 1, report = FALSE, rep.freq = 1, tau0 = 1, tau = 0.1, del0 = 1, epsx = 1e-05, delmin = 0.1 * del0, epsdif = 1e-08, nreset.multiplier = 1, difftype = 3, epsfcn = 1e-16, taubnd = 1, hessian = FALSE, te0 = TRUE, te1 = FALSE, te2 = FALSE, te3 = FALSE, silent = TRUE, intakt = TRUE) { # A function implemented by Diethelm Wuertz # FUNCTION: # Control Parameters: control <- list( iterma = iterma, nstep = nstep, fnscale = fnscale, report = report, rep.freq = rep.freq, tau0 = tau0, tau = tau, del0 = del0, epsx = 1e-05, delmin = delmin, epsdif = epsdif, nreset.multiplier = nreset.multiplier, difftype = difftype, epsfcn = epsfcn, taubnd = taubnd, hessian = hessian, te0 = te0, te1 = te1, te2 = te2, te3 = te3, silent = silent, intakt = intakt) # Return Value: control } ################################################################################ fPortfolio/R/mathprogLP-neos.R0000644000175100001440000001663412410250032015755 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # rneoslLP Rmetrics Interface for AMPL/NEOS LP solvers # neoslLP Convenience wrapper for AMPL/NEOS LP solvers # neoslLPControl AMPL/NEOS LP control parameter list ############################################################################### rneosLP <- function(objective, lower=0, upper=1, linCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Implements AMPL LP Interface # Arguments: # objective - vec # FUNCTION: # Control List: ctrl <- neosLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Controls: solver <- control$solver category <- control$category project <- control$project inf <- control$inf trace <- control$trace # Objective: vec <- objective # Box Constraints: replicate <- function(x, n) if(length(x) == 1) rep(x, n) else x n <- length(vec) x_L <- replicate(lower, n) x_U <- replicate(upper, n) x_L[is.infinite(x_L)] <- inf*sign(x_L[is.infinite(x_L)]) x_U[is.infinite(x_U)] <- inf*sign(x_U[is.infinite(x_U)]) # Linear Constraints: A <- linCons[[1]] m <- nrow(A) b_L <- replicate(linCons[[2]], m) b_U <- replicate(linCons[[3]], m) b_L[is.infinite(b_L)] <- inf*sign(b_L[is.infinite(b_L)]) b_U[is.infinite(b_U)] <- inf*sign(b_U[is.infinite(b_U)]) # Optimize Portfolio: value <- neosLP(vec, x_L, x_U, A, b_L, b_U, control) # Return Value: value } # ------------------------------------------------------------------------- neosLP <- function( objective, x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Universal function wrapper for AMPL LP solvers # Arguments: # objective - vec # FUNCTION: # Control List: ctrl <- neosLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Control Parameters: solver <- control$solver category <- control$category project <- control$project inf <- control$inf trace <- control$trace # Objective: c <- objective n <- length(vec) m <- nrow(A) # Write AMPL Model File: amplModelOpen(project) model <- c( "param n ;", "param m ;", "param c{1..n} ;", "param x_L{1..n} ;", "param x_U{1..n} ;", "param A{1..m, 1..n} ;", "param b_L{1..m} ;", "param b_U{1..m} ;", "var x{1..n};", "minimize Objective: sum {i in 1..n} x[i]*c[i] ;", "s.t. lower {i in 1..n}: x[i] >= x_L[i] ;", "s.t. upper {i in 1..n}: x[i] <= x_U[i] ;", "s.t. linLower {j in 1..m}: sum{i in 1..n} A[j, i]*x[i] >= b_L[j] ;", "s.t. linUpper {j in 1..m}: sum{i in 1..n} A[j, i]*x[i] <= b_U[j] ;", NULL) amplModelAdd(model, project) if (trace) amplModelShow(project) # Write AMPL Data File: amplDataOpen(project) amplDataAddValue (data="n", value=n, project) amplDataAddValue (data="m", value=m, project) amplDataAddVector(data="c", vector=c, project) amplDataAddVector(data="x_L", vector=x_L, project) amplDataAddVector(data="x_U", vector=x_U, project) amplDataAddMatrix(data="A", matrix=A, project) amplDataAddVector(data="b_L", vector=b_L, project) amplDataAddVector(data="b_U", vector=b_U, project) if (trace) amplDataShow(project) # Write AMPL/NEOS RUN File: amplRunOpen(project) run <- c( "solve ;", "display x;", "display solve_result_num;", "display solve_result;", "display solve_message;", "exit ;") amplRunAdd(run, project) if (trace) amplRunShow(project) # Get AMPL Files: model <- paste(readLines("ampl.mod"), sep = " ", collapse ="\n") data <- paste(readLines("ampl.dat"), sep = " ", collapse ="\n") run <- paste(readLines("ampl.run"), sep = " ", collapse ="\n") # Setup NEOS and AMPL Specifications: amplSpec <- list(model=model, data=data, commands=run, comments="NEOS") solverTemplate <- rneos::NgetSolverTemplate(category=category, solvername=solver, inputMethod="AMPL") xmls <- rneos::CreateXmlString(neosxml=solverTemplate, cdatalist=amplSpec) # Submit and Fetch NEOS Job: submittedJob <- rneos::NsubmitJob(xmlstring=xmls, user="rneos", interface="", id=0) ans <- rneos::NgetFinalResults(obj=submittedJob, convert=TRUE) out <- strsplit(ans@ans, split="\n")[[1]] # Get Weights: Index <- (grep("x .*. :=", out)+1):( grep("^;$", out)-1) Out <- out[Index] splits <- strsplit(paste(Out, collapse=" "), " ")[[1]] solution <- as.numeric(splits[splits != ""])[seq(2, 2*n, by=2)] Index <- as.numeric(splits[splits != ""])[seq(1, 2*n, by=2)] solution[Index] <- solution # Get Status: status <- strsplit(out[grep("solve_result", out)], split=" ") statusCode <- status[[1]][3] statusMessage <- status[[2]][3] # Get Solver Message: Index <- grep("solve_message", out):length(out) message <- out[Index] # Neos Job Version: version <- out[1] # Compute Obective Function Value: objval <- (c %*% solution)[[1, 1]] # Return Value: model <- capture.output(amplModelShow(project)) run <- capture.output(amplModelShow(project)) value <- list( opt = list(solve=solve, model=model, run=run, out=out), solution = solution, objective = objval, status = statusCode, message = statusMessage, solver = paste("AMPL", solver), version = version) class(value) <- c("solver", "list") value } # ------------------------------------------------------------------------- neosLPControl <- function(solver="ipopt", category="lp", project="neos", inf=1e12, trace=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns control parameter list # FUNCTION: # Return Value: list(solver=solver, category=category, project=project, inf=inf, trace=trace) } ############################################################################### fPortfolio/R/utils-amplInterface.R0000644000175100001440000002704512323217770016663 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # amplModelOpen Opens a writes to an AMPL model file # amplModelAdd Adds model specs to an existing AMPL model file # amplModelShow Shows the content of an AMPL .mod file # FUNCTION: DESCRIPTION: # amplDataOpen Opens and writes the header to an AMPL data file # amplDataAddValue Adds a numeric value to an AMPL data file # amplDataAddVector Adds a numeric vector to an AMPL data file # amplDataAddMatrix Adds a numeric matrix to an AMPL data file # amplDataSemicolon Adds a semicolon on the end of a data input line # amplDataShow Shows the content of an AMPL data file # FUNCTION: DESCRIPTION: # amplRunOpen Opens a run file # amplRunAdd Adds run specs to an existing AMPL run file # amplRunShow Shows the content of an AMPL run file # FUNCTION: DESCRIPTION: # amplOutShow Shows the content of an AMPL output txt file ################################################################################ amplModelOpen <- function(project) { # A function written by Diethelm Wuertz # Description: # Writes an AMPL model to a .mod file # Arguments: # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file <- paste(project, "mod", sep = ".") # Write Model to File: write("", file=file, ncolumns=1, append=FALSE) # Return Value: invisible() } # ------------------------------------------------------------------------------ amplModelAdd <- function(model, project) { # A function written by Diethelm Wuertz # Description: # Writes an AMPL model to a .mod file # Arguments: # model - a character vector with the lines making the model file # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file <- paste(project, "mod", sep = ".") # Write Model to File: write(model, file=file, ncolumns=1, append=TRUE) # Return Value: invisible() } # ------------------------------------------------------------------------------ amplModelShow <- function(project) { # A function written by Diethelm Wuertz # Description: # Prints an AMPL .mod file # Arguments: # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file <- paste(project, "mod", sep = ".") # Trace File: cat(readLines(file), sep = "\n") # Return Value: invisible() } ################################################################################ amplDataOpen <- function(project) { # A function written by Diethelm Wuertz # Description: # Writes the header to an AMPL data file # Arguments: # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file <- paste(project, "dat", sep = ".") # Write to the file: write("", file=file, ncolumns=1, append=FALSE) # Return Value: invisible() } # ------------------------------------------------------------------------------ amplDataAdd <- function(name, data, type, project) { # A function written by Diethelm Wuertz # Description: # Check data type and adds to AMPL data file # Arguments: # name - AMPL data name # data - the data object, a numeric value, vector or matrix # type - eiher "value", "vector" or "matrix" # project - a project name, gives the root name of the model file # FUNCTION: # Add Data: if (type == "value") { amplDataAddValue(data=name, value=data, project=project) } if (type == "vector") { amplDataAddVector(data=name, vector=data, project=project) } if (type == "matrix") { amplDataAddMatrix(data=name, matrix=data, project=project) } # Return Value: invisible() } # ------------------------------------------------------------------------------ amplDataShow <- function(project) { # A function written by Diethelm Wuertz # Description: # Prints an AMPL data file # Arguments: # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file <- paste(project, "dat", sep = ".") # Trace File: cat(readLines(file), sep = "\n") # Return Value: invisible() } # ----------------------------------------------------------------------------- amplDataSemicolon <- function(project) { # A function written by Diethelm Wuertz # Description: # Adds a semicolon on the end of a data input line # Arguments: # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file <- paste(project, "dat", sep = ".") # Add a Semicolon and an Empty Line: write(";", file=file, ncolumns=1, append=TRUE) write(" ", file=file, ncolumns=1, append=TRUE) # Return Value: invisible() } # ------------------------------------------------------------------------------ amplDataAddValue <- function(data, value, project) { # A function written by Diethelm Wuertz # Description: # Adds a numeric value to an AMPL data file # Arguments: # data - a character string, the name of the value # value - a numeric value, the value of the numeric input variable # project - a project name, gives the root name of the model file # FUNCTION: name <- data # Compose File Name: file <- paste(project, "dat", sep = ".") # Write Name: x <- paste("param", name, ":=", collapse=" ") write(x, file=file, ncolumns=1, append=TRUE) # Write Numeric Value: write(value, file=file, ncolumns=1, append=TRUE) amplDataSemicolon(project) # Return Value: invisible() } # ------------------------------------------------------------------------------ amplDataAddVector <- function(data, vector, project) { # A function written by Diethelm Wuertz # Description: # Adds a numeric vector to an AMPL data file # Arguments: # data - a character string, the name of the vector # value - a numeric vector, the values of the numeric input vector # project - a project name, gives the root name of the model file # FUNCTION: name <- data # Compose File Name: file = paste(project, "dat", sep = ".") # Write Name: x <- paste("param", name, ":=", collapse=" ") write(x, file=file, ncolumns=1, append=TRUE) # Write Vector: vector <- as.vector(vector) N <- length(vector) write(t(cbind(1:N, vector)), file=file, ncolumns=2, append=TRUE) amplDataSemicolon(project) # Return Value: invisible() } # ------------------------------------------------------------------------------ amplDataAddMatrix <- function(data, matrix, project) { # A function written by Diethelm Wuertz # Description: # Adds a numeric matrix to an AMPL data file # Arguments: # data - a character string, the name of the matrix # value - a numeric matrix, the values of the numeric input matrix # project - a project name, gives the root name of the model file # FUNCTION: name <- data # Compose File Name: file <- paste(project, "dat", sep = ".") # Write Name: x <- paste("param", name, ":", collapse=" ") write(x, file=file, ncolumns=1, append=TRUE) # Write Matrix: N <- ncol(matrix) x <- paste(paste(1:N, collapse = " "), ":=") write(x, file = file, ncolumns = 1, append = TRUE) X <- cbind(1:nrow(matrix), matrix) colnames(X) = rownames(X) = NULL write(t(X), file = file, ncolumns = 1, append = TRUE, sep = " ") amplDataSemicolon(project) # Return Value: invisible() } ################################################################################ amplRunOpen <- function(project) { # A function written by Diethelm Wuertz # Description: # Writes an AMPL run to a .run file # Arguments: # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file <- paste(project, "run", sep = ".") # Open: write("", file=file, ncolumns=1, append=FALSE) # Return Value: invisible() } # ----------------------------------------------------------------------------- amplRunAdd <- function(run, project) { # A function written by Diethelm Wuertz # Description: # Writes an AMPL run to a .run file # Arguments: # run - a character vector with the lines making the model file # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file <- paste(project, "run", sep = ".") # Write Run Commands to File: write(run, file=file, ncolumns=1, append=FALSE) # Return Value: invisible() } # ------------------------------------------------------------------------------ amplRunShow <- function(project) { # A function written by Diethelm Wuertz # Description: # Prints an AMPL .run file # Arguments: # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file = paste(project, "run", sep = ".") # Trace File: cat(readLines(file), sep = "\n") # Return Value: invisible() } ################################################################################ amplOutShow <- function(project) { # A function written by Diethelm Wuertz # Description: # Shows the content of an AMPL output txt file # Arguments: # project - a project name, gives the root name of the model file # FUNCTION: # Compose File Name: file <- paste(project, "txt", sep = ".") # Trace File: cat(readLines(file), sep = "\n") # Return Value: invisible() } ################################################################################ fPortfolio/R/solve-Rsocp.R0000644000175100001440000001461512410474512015162 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRsocp Portfolio interface to solver Rsocp # .rsocpArguments Returns arguments for solver # .rsocp Wrapper to solver function # .rsocpControl Returns default controls for solver ################################################################################ solveRsocp <- function(data, spec, constraints) { # Description: # Portfolio interface to solver Rsocp # Example: # ans = solveRquadprog(.lppData, .mvSpec, "LongOnly")[-3] # .mvSpec2 = .mvSpec; setTargetRisk(.mvSpec2) = ans$targetRisk # solveRsocp(.lppData, .mvSpec2, "LongOnly")[-3]; ans # efficientortfolio # FUNCTION: # Transform Data and Constraints: Data = portfolioData(data, spec) # Trace: trace <- getTrace(spec) if(trace) cat("\nPortfolio Optimiziation:\n Using Rsocp ...\n\n") # Get Specifications: nAssets = getNAssets(Data) # Create '.rsocp' conform arguments: args <- .rsocpArguments(data, spec, constraints) # Optimize: ans <- .rsocp( f = args$f, A = args$A, b = args$b, C = args$C, d = args$d, N = args$N, targetRisk = args$targetRisk, mu = args$mu, Scale = args$Scale) # Return Value: class(ans) = c("solver", "list") ans } ################################################################################ .rsocpArguments <- function(data, spec, constraints) { # Description: # Returns socp conform arguments for the solver # Example: # .rsocpArguments(data, spec, constraints) # FUNCTION: # Settings: Data = portfolioData(data, spec) nAssets = getNAssets(Data) Scale = 1.0e6 * sd(as.vector(data)) mu = getMu(Data) / Scale Sigma = getSigma(Data) / Scale^2 targetRisk = getTargetRisk(spec) / Scale # Objective Function: f <- -mu # Constraints: eqsumW = eqsumWConstraints(data, spec, constraints) # C - Cone Constraints: C1 <- rep(0, nAssets) # xCx C2 <- eqsumW[2, -1] # sum(x) C3 <- rbind(diag(nAssets), -diag(nAssets) ) # x[i]>0 # d - Cone Constraints: d1 <- targetRisk # xCx = risk d2 <- eqsumW[2, 1] # sum(x) <= 1 d3 <- c(rep(0, nAssets), rep(-1, nAssets)) # x[i] > 0 # A - Cone Constraints: A1 <- Rsocp::.SqrtMatrix(Sigma) A2 <- matrix(0, ncol = nAssets) A3 <- matrix(0, nrow = nrow(C3), ncol = nAssets) # b - Cone Constraints: b1 <- rep(0, nAssets) # xCx b2 <- 0 # sum(x) b3 <- rep(0, nrow(C3)) # x[i]>0 # N - Cone Constraints: N1 <- nAssets # dim(C) N2 <- 1 # Full Investment N3 <- rep(1, nrow(C3)) # Long # Combine Constraints for SOCP: A <- rbind(A1, A2, A3) b <- c(b1, b2, b3) C <- rbind(C1, C2, C3) d <- c(d1, -d2, -d3) N <- c(N1, N2, N3) # Return Value: list(f = f, A = A, b = b, C = C, d = d, N = N, targetRisk = targetRisk * Scale, mu = mu * Scale, Scale = Scale) } ################################################################################ .rsocp <- function(f, A, b, C, d, N, x = NULL, z = NULL, w = NULL, targetRisk, mu = mu, Scale = Scale, control = .rsocpControl()) { # Description: # SOCP solver function for portfolios # Details: # Package: fPortfolio # Title: An R extenstion library to use SOCP from R. # Version: 0.1 as of 2008-31-01 # Author: Yohan Chalabi and Diethelm Wuertz # Description: Second-order cone programming solver # written by M. Lobo, L. Vandenberghe, and S. Boyd. # R.socp is a wrapper library to use it from R. # License: R.socp - GPL # FUNCTION # Solve Portfolio: optim <- Rsocp::socp(f, A, b, C, d, N, x, z, w, control) # Extract Weights: weights = .checkWeights(optim$x) attr(weights, "invest") = sum(weights) # Prepare Output List: ans <- list( type = "MV", solver = "solveRsocp", optim = optim, weights = weights, targetReturn = (weights %*% mu)[[1]], targetRisk = targetRisk, objective = (weights %*% mu)[[1]], status = as.integer(!optim$convergence), message = optim$message) # Return Value: ans } ################################################################################ .rsocpControl <- function(abs.tol = 1.0e-18, rel.tol = 1.0e-16, target = 0, max.iter = 1000, Nu = 10, out.mode = 0, BigM.K = 2, BigM.iter = 5) { # Description: # Control list for portfolio SOCP optimization # FUNCTION: # Return Value: list( abs.tol = abs.tol, rel.tol = rel.tol, target = target, max.iter = max.iter, Nu = Nu, out.mode = out.mode, BigM.K = BigM.K, BigM.iter = BigM.iter) } ################################################################################ fPortfolio/R/mathprogNLP-solnp.R0000644000175100001440000002232112410257402016260 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # rsolnpNLP NLP wrapper for solver solnpNLP() # solnpNLP NLP wrapper for solver solnp() # solnpNLPControl Control parameter list # REQUIRES: # solnp Solver in package Rsolnp ################################################################################ rsolnpNLP <- function(start, objective, lower=0, upper=1, linCons, funCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Function wrapper for solver solnp() # FUNCTION: # Load: # require(Rsolnp) # Update Control List: ctrl <- solnpNLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl BIG <- 1e6 N <- length(start) # Box Constraints: if(length(lower) == 1) { par.lower <- rep(lower, N) } else { par.lower <- lower } if(length(upper) == 1) { par.upper <- rep(upper, N) } else { par.upper <- upper } par.lower[is.infinite(par.lower)] <- BIG*sign(par.lower[is.infinite(par.lower)]) par.upper[is.infinite(par.upper)] <- BIG*sign(par.upper[is.infinite(par.upper)]) # Linear Constraints: if(missing(linCons)) { eqA <- ineqA <- NULL eqA.bound <- ineqA.lower <- ineqA.upper <- NULL } else { mat <- linCons[[1]] M <- nrow(mat) lower <- linCons[[2]] upper <- linCons[[3]] if(length(lower) == 1) lower <- rep(lower, M) if(length(upper) == 1) upper <- rep(upper, M) lower[is.infinite(lower)] <- BIG*sign(lower[is.infinite(lower)]) upper[is.infinite(upper)] <- BIG*sign(upper[is.infinite(upper)]) eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) if (length(eqIndex) == 0) { eqA <- NULL eqA.bound <- NULL } else { eqA <- mat[eqIndex, ] eqA.bound <- lower[eqIndex] } if (length(ineqIndex) == 0) { ineqA <- NULL ineqA.lower <- NULL ineqA.upper <- NULL } else { ineqA <- mat[ineqIndex, ] ineqA.lower <- lower[ineqIndex] ineqA.upper <- upper[ineqIndex] } } # Nonlinear Constraints: if(missing(funCons)) { eqFun <- ineqFun <- list() eqFun.bound <- ineqFun.lower <- ineqFun.upper <- NULL } else { fun <- funCons[[1]] lower <- funCons[[2]] upper <- funCons[[3]] eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) if (length(eqIndex) == 0) { eqFun <- list() eqFun.boud <- NULL } else { eqFun = fun[eqIndex] eqFun.bound = lower[eqIndex] } if (length(ineqIndex) == 0) { ineqFun <- list() ineqFun.lower <- NULL ineqFun.upper <- NULL } else { ineqFun = fun[ineqIndex] ineqFun.lower <- lower[ineqIndex] ineqFun.upper <- upper[ineqIndex] } } # Optimize Portfolio: elapsed <- Sys.time() optim <- solnpNLP( start = start, objective = objective, par.lower = par.lower, par.upper = par.upper, eqA = eqA, eqA.bound = eqA.bound, ineqA = ineqA, ineqA.lower = ineqA.lower, ineqA.upper = ineqA.upper, eqFun = eqFun, eqFun.bound = eqFun.bound, ineqFun = ineqFun, ineqFun.lower = ineqFun.lower, ineqFun.upper = ineqFun.upper, control = control) elapsed <- Sys.time() - elapsed # Version: package <- packageDescription(pkg="Rsolnp") version <- paste(package$Package, package$Version, package$Date) # Return Value: value <- list( opt = optim, solution = optim$solution, objective = objective(optim$solution), status = optim$status, message = optim $message, solver = "solnpNLP", elapsed = elapsed, version = version) class(value) <- c("solver", "list") # Return Value: value } ################################################################################ solnpNLP <- function( start, objective, par.lower = NULL, par.upper = NULL, eqA = NULL, eqA.bound = NULL, ineqA = NULL, ineqA.lower = NULL, ineqA.upper = NULL, eqFun = list(), eqFun.bound = NULL, ineqFun = list(), ineqFun.lower = NULL, ineqFun.upper = NULL, control = list()) { # A function implemented by Diethelm Wuertz # Description: # Universal function wrapper for solver solnp(). # FUNCTION: # Load: # require(Rsolnp) fun <- objective # Control List: ctrl <- solnpNLPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Environment Setting: env <- .GlobalEnv # Box Constraints: BIG <- 1e8 # inf does not works here, DW. if (is.null(par.lower)) par.lower <- rep(-BIG, length(start)) if (is.null(par.upper)) par.upper <- rep(+BIG, length(start)) # Linear and Function Equality Constraints: if (length(eqA) > 0 || length(eqFun) > 0 ) { eqfun <- function(x) { ans <- NULL if(!is.null(eqA)) ans <- c(ans, as.vector(eqA %*% x)) if (length(eqFun) > 0) for (i in 1:length(eqFun)) ans <- c(ans, eqFun[[i]](x)) ans } } else { eqfun <- NULL } eqB <- c(eqA.bound, eqFun.bound) # Linear and Function Inequality Constraints: if (length(ineqA) > 0 || length(ineqFun) > 0) { ineqfun <- function(x) { ans <- NULL if(!is.null(ineqA)) ans <- c(ans, as.vector(ineqA %*% x)) if (length(ineqFun) > 0) for (i in 1:length(ineqFun)) ans <- c(ans, ineqFun[[i]](x)) ans } } else { ineqfun <- NULL } ineqLB <- c(ineqA.lower, ineqFun.lower) ineqUB <- c(ineqA.upper, ineqFun.upper) # Optimize Portfolio: elapsed <- Sys.time() optim <- Rsolnp::solnp( pars = start, fun = fun, eqfun = eqfun, eqB = eqB, ineqfun = ineqfun, ineqLB = ineqLB, ineqUB = ineqUB, LB = par.lower, UB = par.upper, control = control) elapsed <- Sys.time() - elapsed names(optim$pars) <- names(start) # Version: package <- packageDescription(pkg="Rsolnp") version <- paste(package$Package, package$Version, package$Date) # Return Value: value <- list( opt = optim, solution = optim$pars, objective = fun(optim$pars), status = optim$convergence, message = "not available", solver = "solnpNLP", elapsed = elapsed, version = version) class(value) <- c("solver", "list") value } ############################################################################### solnpNLPControl <- function( rho = 1, outer.iter = 400, inner.iter = 800, delta = 1.0e-7, tol = 1.0e-8, trace = 0) { # A function implemented by Diethelm Wuertz # Description: # Returns control list # Arguments: # rho - a numeric value. The penalty parameter # majit - an integer value. The maximum number of major iterations # minit - an integer value. The maximum number of minor iterations # delta - a numeric value. The relative step size in forward # difference evaluation # tol - a numeric value. The tolerance on feasibility and optimality # Notes: # DW: default trace=1 changed to trace=0 # FUNCTION: # Control Parameters: control <- list( rho = rho, outer.iter = outer.iter, inner.iter = inner.iter, delta = delta, tol = tol, trace = trace) # Return Value: control } ############################################################################### fPortfolio/R/solve-RshortExact.R0000644000175100001440000001154212323217770016342 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRshortExact Portfolio interface to solver RshortExact # .rshortExactArguments Returns arguments for solver # .rshortExact Wrapper to solver function ################################################################################ solveRshortExact <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Portfolio interface to solver RshortExact # Details: # If getTargetReturn() is specified we minimze the risk, # if getTargetRisk() is pecified we maximize the risk. # FUNCTION: # Convert Data and Constraints to S4 Objects: Data <- portfolioData(data, spec) data <- getSeries(Data) Sigma <- getSigma(Data) Constraints <- portfolioConstraints(Data, spec, constraints) # Stop if the Target Return is not Defined! optimize <- getOptimize(spec) targetReturn <- getTargetReturn(spec) targetRisk <- getTargetRisk(spec) # Get '.rshortexact' conform arguments: args <- .rshortExactArguments(Data, spec, Constraints) # Solve Portfolio: ans <- .rshortExact( optimize = optimize, C0 = args$C0, a = args$a, b = args$b, c = args$c, d = args$d, Sigma = Sigma, invSigma = args$invSigma, mu = args$mu, targetReturn, targetRisk) # Return Value: class(ans) <- c("solver", "list") ans } # ------------------------------------------------------------------------------ .rshortExactArguments <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Returns 'shortexact' conform arguments for the solver # FUNCTION: # Data as S4 Objects: Data <- portfolioData(data, spec) data <- getSeries(Data) # Get Specifications: mu <- getMu(Data) Sigma <- getSigma(Data) weights <- getWeights(spec) targetReturn <- getTargetReturn(spec) targetRisk <- getTargetRisk(spec) # Parameter Settings: C0 <- 1 one <- rep(1, times = length(mu)) invSigma <- solve(Sigma) a <- as.numeric(mu %*% invSigma %*% mu) b <- as.numeric(mu %*% invSigma %*% one) c <- as.numeric(one %*% invSigma %*% one) d <- as.numeric(a*c - b^2) # Return Value: list(C0 = C0, a = a, b = b, c = c, d = d, mu = mu, invSigma = invSigma) } ################################################################################ .rshortExact <- function(optimize, C0, a, b, c, d, Sigma, invSigma, mu, targetReturn, targetRisk) { # A function implemented by Diethelm Wuertz # Description: # Analytical 'shortexact' solver function # FUNCTION: # Optimize: if (!is.null(targetReturn)) { if (optimize == "minRisk") { # Compute Target Risk: objective <- targetRisk <- sqrt((c*targetReturn^2 - 2*b*C0*targetReturn + a*C0^2) / d) } else if (optimize == "maxReturn") { # Compute Target Return: aq <- c bq <- -2*b*C0 cq <- a*C0^2 - d*targetRisk^2 objective <- targetReturn <- (-bq + sqrt(bq^2 - 4*aq*cq)) / (2*aq) } } # Compute Weights: if (is.null(targetReturn)) { # global minimum Variance Portfolio: optimize <- "minvariancePortfolio" one <- rep(1, times=length(mu)) weights <- as.vector(invSigma %*% one) / ( one %*% invSigma %*% one ) objective <- t(weights) %*% Sigma %*% weights } else { weights <- as.vector(invSigma %*% ((a-b*mu)*C0 + (c*mu-b)*targetReturn )/d) } weights <- .checkWeights(weights) # Return Value: list( type = "MV", solver = "solveRshortExact", optim = NA, solution = weights, weights = weights, targetReturn = targetReturn, targetRisk = targetRisk, objective = objective, status = 0, message = optimize) } ################################################################################ fPortfolio/R/backtest-setBacktestSpec.R0000644000175100001440000001424512323217770017636 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # setWindowsFun<- Sets name of rolling windows function # setWindowsParams<- Sets additional parameters to windows function # setWindowsHorizon<- Sets horizon of the rolling window # FUNCTION: DESCRIPTION: # setStrategyFun<- Sets name of portfolio strategy function # setStrategyParams<- Sets additional parameters to strategy function # FUNCTION: DESCRIPTION: # setSmootherFun<- Sets name of weights smoothing function # setSmootherParams<- Sets additional parameters to smoother function # setSmootherLambda<- Sets lambda for EMA smoothing # setSmootherDoubleSmoothing<- Sets double ema setting, logical # setSmootherInitialWeights<- Sets initial weights of the portfolio # setSmootherSkip<- Sets number of months to skip starting ################################################################################ "setWindowsFun<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets name of rolling windows function # Arguments: # FUNCTION: # Set Value: backtest@windows$windows <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setWindowsParams<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets additional parameters to windows function # Arguments: # FUNCTION: # Set Value: backtest@windows$params <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setWindowsHorizon<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets horizon of the rolling window # Arguments: # FUNCTION: # Set Value: backtest@windows$params$horizon <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setStrategyFun<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets portfolio strategy function # Arguments: # FUNCTION: # Set Value: backtest@strategy$strategy <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setStrategyParams<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets additional parameters to strategy function # Arguments: # FUNCTION: # Set Value: backtest@strategy$params <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setSmootherFun<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets name of weights smoothing function # Arguments: # FUNCTION: # Set Value: backtest@smoother$smoother <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setSmootherParams<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets additional parameters to smoother function # Arguments: # FUNCTION: # Set Value: backtest@smoother$params <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setSmootherLambda<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets lambda parameter for EMA smoothing # Arguments: # FUNCTION: # Set Value: backtest@smoother$params$lambda <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setSmootherDoubleSmoothing<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets double EMA setting, TRUE or FALSE, a logical # Arguments: # FUNCTION: # Set Value: backtest@smoother$params$doubleSmoothing <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setSmootherInitialWeights<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets initial weights of the portfolio # Arguments: # FUNCTION: # Set Value: backtest@smoother$params$initialWeights <- value # Return Value: backtest } # ------------------------------------------------------------------------------ "setSmootherSkip<-" <- function(backtest, value) { # A function implemented by William Chen # Description: # Sets number of months to skip starting values # Arguments: # FUNCTION: # Set Value: backtest@smoother$params$skip <- value # Return Value: backtest } ################################################################################ fPortfolio/R/frontier-weightPlots.R0000644000175100001440000002473312323217770017113 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # .weightsWheel Adds a pie of weights to frontier plot # .attributesWheel Adds a pie of attributes to frontier plot # FUNCTION: DESCRIPTION: # .notStackedWeightsPlot Plots the not stacked weights of potfolio # .addlegend Adds legend to sliders ################################################################################ .weightsWheel <- function(object, piePos = NULL, pieR = NULL, pieOffset = NULL, ...) { # A function implemented by Oliver Greshake and Diethelm Wuertz # Description: # Adds a pie plot of weights for MV and CVaR Portfolios # Arguments: # Details: # The default settings are: # piePos - Position of tangency Portfolio # pieR - 10% of the Risk Range: diff(range(targetRisk(object)))/10 # FUNCTION: # Extract Coordinates: p = par()$usr/15 dx = p[2]-p[1] dy = p[4]-p[3] # Pie Position: if(is.null(piePos)) { Data = getSeries(object) Spec = getSpec(object) Constraints = getConstraints(object) tg = getTargetReturn(tangencyPortfolio(Data, Spec, Constraints)) ef = as.vector(getTargetReturn(object)) piePos = which(diff(sign(ef-tg)) > 0) } # Pie Radius: if(is.null(pieR)) { pieR = c(1, 1) } # Pie Offset: if(is.null(pieOffset)) { pieOffset = c(-2*dx, 0) } # Plot Circle: weights = getWeights(object)[piePos, ] nWeights = length(weights) Sign = rep("+", nWeights) Sign[(1:nWeights)[weights < 0]] = "-" x = getTargetRisk(object)[piePos] y = getTargetReturn(object)[piePos] phi = seq(0, 2*pi, length = 360) X = x + pieOffset[1] + pieR[1] * sin(phi) * dx Y = y + pieOffset[2] + pieR[2] * cos(phi) * dy lines(X, Y) # Add Center Point: points(x, y, col = "red", pch = 19, cex = 1.5) # Add Arrow: lines(c(x, x+pieOffset[1]), c(y, y+pieOffset[2])) # Add Color Wheel: psi = 2*pi*c(0, cumsum(abs(weights)/sum(abs(weights)))) for (i in 1 : length(weights) ) { # Plotting Only Pie pieces with Weights > 5% if(psi[i+1]-psi[i] > 0.05 * 2*pi) { Psi = psi[i] + (0:100) * (psi[i+1]-psi[i])/100 polyX = x + pieOffset[1] + pieR[1]*c(0, sin(Psi), 0) * dx polyY = y + pieOffset[2] + pieR[2]*c(0, cos(Psi), 0) * dy polygon(polyX, polyY, col = rainbow(nWeights)[i]) # Adding the Asset Signs: text(x + pieOffset[1] + 0.75*pieR[1]* sin(Psi[51]) * dx, y + pieOffset[2] + 0.75*pieR[2]* cos(Psi[51]) * dy, col = "white", Sign[i]) } } # Return Value: invisible() } # ------------------------------------------------------------------------------ .attributesWheel <- function(object, piePos = NULL, pieR = NULL, pieOffset = NULL, ...) { # A function implemented by Oliver Greshake and Diethelm Wuertz # Description: # Adds a pie plot of the weights # Arguments: # Details: # The default settings are: # piePos - Position of tangency Portfolio # pieR - 10% of the Risk Range: diff(range(targetRisk(object)))/10 # FUNCTION: # Extraction coordinates p = par()$usr/15 dx = p[2]-p[1] dy = p[4]-p[3] # Pie Position: if(is.null(piePos)) { Data = getSeries(object) Spec = getSpec(object) Constraints = getConstraints(object) tg = getTargetReturn(tangencyPortfolio(Data, Spec, Constraints)) ef = as.vector(getTargetReturn(object)) piePos = which(diff(sign(ef-tg)) > 0) } # Pie Radius: if(is.null(pieR)) { pieR = c(1, 1) } # Pie Offset: if(is.null(pieOffset)) { pieOffset = c(2*dx, 0) } # Plot Circle - Get weighted Returns: weights = getWeights(object) dim = dim(weights) returns = getStatistics(object)$mu weightedReturns = NULL for(i in 1:dim[2]){ nextWeightedReturns = weights[,i]*returns[i] weightedReturns = cbind(weightedReturns, nextWeightedReturns) } colnames(weightedReturns) = colnames(weights) weightedReturns = weightedReturns[piePos, ] nWeights = length(weightedReturns) Sign = rep("+", times = nWeights) Sign[(1:nWeights)[weightedReturns < 0]] = "-" x = getTargetRisk(object)[piePos] y = getTargetReturn(object)[piePos] phi = seq(0, 2*pi, length = 360) X = x + pieOffset[1] + pieR[1] * sin(phi) * dx Y = y + pieOffset[2] + pieR[2] * cos(phi) * dy lines(X, Y) # Add Center Point: points(x, y, col = "red", pch = 19, cex = 1.5) # Add Arrow: lines(c(x, x+pieOffset[1]), c(y, y+pieOffset[2])) # Add Color Wheel: psi = 2*pi*c(0, cumsum(abs(weightedReturns)/sum(abs(weightedReturns)))) for (i in 1 : nWeights) { # Plotting Only Pie pieces with Weights > 5% if(psi[i+1]-psi[i] > 0.05 * 2*pi) { Psi = psi[i] + (0:100) * (psi[i+1]-psi[i])/100 polyX = x + pieOffset[1] + pieR[1]*c(0, sin(Psi), 0) * dx polyY = y + pieOffset[2] + pieR[2]*c(0, cos(Psi), 0) * dy polygon(polyX, polyY, col = rainbow(nWeights)[i]) # Adding the Asset Signs: text(x + pieOffset[1] + 0.75*pieR[1]* sin(Psi[51]) * dx, y + pieOffset[2] + 0.75*pieR[2]* cos(Psi[51]) * dy, col = "white", Sign[i]) } } # Return Value: invisible() } #------------------------------------------------------------------------------- .notStackedWeightsPlot <- function(object, col = NULL) { # A function implemented by Oliver Greshake # Description: # Arguments: # object - an object of class 'fPORTFOLIO' # col - a color palette, by default the rainbow palette # FUNCTION: # Settings: weights = getWeights(object) N = ncol(weights) targetRisk = getTargetRisk(object)[, 1] targetReturn = getTargetReturn(object)[, 1] nSigma = length(targetRisk) # Select Colors if not specified ... if (is.null(col)) col = rainbow(N) # Plot first asset ... plot(weights[, 1], col = col[1], type = "l", ylim = c(min(weights), max(weights)), xaxt = "n", xlab = "", ylab = "") # Add vertical Line at minimum risk: minIndex = which.min(targetRisk) minRisk = min(targetRisk) # Big Point at minimum risk for first asset ... points(x = minIndex, y = weights[minIndex, 1], col = col[1], pch = 19, xaxt = "n", yaxt = "n", cex = 2) # ... and all other assets for(i in 1:(N-1)){ points(weights[, i+1], col = col[i+1], type = "l", xaxt = "n", yaxt = "n") points(x = minIndex, y = weights[minIndex, i+1], col = col[i+1], pch = 19, xaxt = "n", yaxt = "n", cex = 2) } grid() abline(h = 0, col = "grey", lty = 3) lines(x = c(minIndex, minIndex), y = c(0, 1), col = "black", lwd = 2) # Add Tailored Labels - 6 may be a good Number ... nLabels = 6 M = c(0, ( 1: (nSigma %/% nLabels) ) ) * nLabels + 1 text(minIndex, 1, "Min Risk", pos = 4) minRiskValue = as.character(signif(minRisk, 3)) minReturnValue = as.character(signif(targetReturn[minIndex], 3)) mtext(minRiskValue, side = 1, at = minIndex, cex = 0.7) mtext(minReturnValue, side = 3, line = 0.5, at = minIndex, cex = 0.7) # Take a reasonable number of significant digits to plot, e.g. 2 ... nPrecision = 3 axis(1, at = M, labels = signif(targetRisk[M], nPrecision)) axis(3, at = M, labels = signif(targetReturn[M], nPrecision)) # Add Axis Labels and Title: mtext("Target Risk", side = 1, line = 2, cex = 0.7) mtext("Target Return", side = 3, line = 2, cex = 0.7) mtext("Weight", side = 2, line = 2, cex = 0.7) # Add Info: mtext(paste(getType(object), "|", getSolver(object)), side = 4, adj = 0, col = "grey", cex = 0.7) # Add Title: mtext("Weights", adj = 0, line = 2.5, font = 2, cex = 0.8) # Return Value: invisible() } #------------------------------------------------------------------------------- .addlegend <- function(object, control = list()) { # A function implemented by Oliver Greshake # Description: # Adds a perdefined legend to sliders # Arguments: # object - an object of class 'fPORTFOLIO' # control - control list for colors and symbols # FUNCTION: # Settings: dim = getNAssets(object) namesSingleAsset = names(object@data$statistics$mu) # Check if polt is used for forntierSlider... if(control$sliderFlag == "frontier"){ legendtext = c("Efficient Frontier", "Sharpe Ratio", "Minimum Variance", "Tangency Portfolio", "Market Portfolio", "Equal Weights", namesSingleAsset) color = c("black", control$sharpeRatio.col, control$minvariance.col, control$tangency.col, control$cml.col, control$equalWeights.col, control$singleAsset.col) sym = c(19, 19, control$minvariance.pch, control$tangency.pch, control$cml.pch, control$equalWeights.pch, rep(control$singleAsset.pch, times = dim)) # ... else is the weightsSlider case } else { legendtext = c("Efficient Frontier", "Minimum Variance", "Tangency Portfolio", namesSingleAsset) color = c("black", control$minvariance.col, control$tangency.col, control$singleAsset.col) sym = c(19, control$minvariance.pch, control$tangency.pch, rep(control$singleAsset.pch, times = dim)) } # Adding Legend: legend("topleft", legend = legendtext, col = color, pch = sym, cex = .8, bty = "n") # Return Value: invisible() } ################################################################################ fPortfolio/R/plot-weightsSlider.R0000644000175100001440000001162212323217770016536 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # weightsSlider Graphical Weights Slider # .counterWeightsSlider ################################################################################ .counterWeightsSlider <- NA # ------------------------------------------------------------------------------ weightsSlider <- function(object, control = list(), ...) { # A function implemented by Rmetrics # Description: # Interactive view of Portfolio Weights # FUNCTION: # Global Variables: object <<- object nFrontierPoints <- length(getTargetRisk(object)[ ,1]) dim = dim(getWeights(object))[2] # Use default, if xlim and ylim is not specified ... mu = getStatistics(object)$mu Sigma = getStatistics(object)$Sigma yLim = range(mu) + 0.25*c(-diff(range(mu)), diff(range(mu))) # First, take care that all assets appear on the plot ... sqrtSig = sqrt(diag(Sigma)) xLimAssets = c(min(sqrtSig), max(sqrtSig))+ c(-0.4*diff(range(sqrtSig)), 0.1*diff(range(sqrtSig))) # ... second take care that the whole frontier appears on the plot: fullFrontier = frontierPoints(object) xLimFrontier = range(fullFrontier[, 1]) xLim = range(c(xLimAssets, xLimFrontier)) xLim[1] = xLim[1]-diff(xLim)/5 # Control Parameters: con <<- list( sliderResolution = 1, sliderFlag = "weights", runningPoint.col = "red", minvariance.col = "red", tangency.col = "steelblue", singleAsset.col = rainbow(dim), minvariance.pch = 19, singleAsset.pch = 19, tangency.pch = 17, runningPoint.cex = 1.5, minvariance.cex = 1, tangency.cex = 1.25, singleAsset.cex = 1, xlim = xLim, ylim = yLim ) con[(Names <- names(control))] <- control # Internal Function: refresh.code = function(...) { # Startup Counter: .counterWeightsSlider <- getRmetricsOptions(".counterWeightsSlider") + 1 setRmetricsOptions(.counterWeightsSlider = .counterWeightsSlider) if (.counterWeightsSlider < 1) return () # Sliders: N = .sliderMenu(no = 1) # Reset Frame: par(mfrow = c(2, 2)) # Plot 1 - Frontier Plot: frontier = frontierPoints(object) fPoint = frontier[N, ] frontierPlot(object, xlim = con$xlim, ylim = con$ylim, xlab = "", ylab = "", pch = 19, cex = 0.7, title = FALSE) mtext("Target Risk", side = 1, line = 2, adj = 1, cex = 0.7) mtext("Target Return", side = 2, line = 2, adj = 1, cex = 0.7) points(fPoint[1], fPoint[2], col = con$runningPoint.col, pch = 19, cex = con$runningPoint.cex) tangencyLines(object, col = con$tangency.col, pch = con$tangency.pch) tangencyPoints(object, col = con$tangency.col) singleAssetPoints(object, col = con$singleAsset.col, cex = con$singleAsset.cex, pch = con$singleAsset.pch) minvariancePoints(object, col = con$minvariance.col, cex = con$minvariancePlot.cex, pch = con$minvariance.pch) Title = paste( "Return =", signif(fPoint[2], 2), "|", "Risk = ", signif(fPoint[1], 2)) Title = "Efficient Frontier" mtext(Title, adj = 0, line = 2.5, font = 2, cex = 0.7) grid() # Plot 2 - Weights Pie: weightsPie(object, pos = N) # Plot 3 - Weights Plot: weightsPlot(object) abline(v = N, col = "black") # Plot 4 - Single Weights Plot: weightsLinePlot(object) abline(v = N, col = "black") } # Open Slider Menu: setRmetricsOptions(.counterWeightsSlider = 0) Start <- which.min(getTargetRisk(object)[ , 1]) .sliderMenu(refresh.code, title = "Weights Slider", names = c( "N"), minima = c( 1), maxima = c( nFrontierPoints), resolutions = c(con$sliderResolution), starts = c( Start)) # Return Value: invisible() } ################################################################################ fPortfolio/R/solve-Rdonlp2.R0000644000175100001440000001614612505272204015414 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRdonlp2 Portfolio interface to solver Rdonlp2 # .rdonlp2Arguments Returns arguments for solver ################################################################################ solveRdonlp2 <- function(data, spec, constraints) { # Description: # Portfolio interface to solver Rdonlp2 # Arguments; # data - an object of class timeSeries # spec - an object of class fPFOLIOSPEC # constraints - an object of class character # Example: # # FUNCTION: # Settings: Data <- portfolioData(data, spec) nAssets <- getNAssets(Data) mu <- getMu(Data) Sigma <- getSigma(Data) # Compose Arguments for Solver: args <- .rdonlp2Arguments(data, spec, constraints) # Solve Multiassets Portfolio: ans <- Rdonlp2::donlp2( par = args$par, fn = args$fn, par.lower = args$par.lower, par.upper = args$par.upper, A = args$A, lin.lower = args$lin.lower, lin.upper = args$lin.upper, nlin = args$nlin, nlin.lower = args$nlin.lower, nlin.upper = args$nlin.upper, control = Rdonlp2::donlp2Control(), control.fun = function(lst) {return(TRUE)}, env = .GlobalEnv, name = NULL) returnFun <- match.fun(getObjective(spec)[2]) ans$targetReturn <- returnFun(ans$par) riskFun <- match.fun(getObjective(spec)[3]) ans$targetRisk <- riskFun(ans$par) ans$ans <- ans ans$solver <- "solveRdonlp2" ans$objective <- args$fn(ans$par) names(ans$par) <- names(start) ans$weights <- .checkWeights(ans$par) ans$solution <- ans$weights attr(ans$weights, "invest") <- sum(ans$weights) ans$status <- 1 message11 <- "KT-conditions satisfied, " message12 <- "computed correction small" message13 <- "stepsizeselection: x almo" if (substr(ans$message, 1, 25) == message11) ans$status <- 0 if (substr(ans$message, 1, 25) == message12) ans$status <- 0 if (substr(ans$message, 1, 25) == message13) ans$status <- 0 # Return Value: class(ans) <- c("solver", "list") ans } # ------------------------------------------------------------------------------ .rdonlp2Arguments <- function(data, spec, constraints) { # Description: # Create Arguments for Rdonlp2 # Details: # min: fn(x) # subject to: # par.lower <= x <= par.upper # lin.lower <= A %*% x <= lin.upper # nlin.lower <= nlin(x) <= nlin.upper # FUNCTION: DEBUG = FALSE # Settings: Data <- portfolioData(data) nAssets <- getNAssets(Data) mu <- getMu(Data) Sigma <- getSigma(Data) fn <- match.fun(getObjective(spec)[1]) # Box Constrains: par.lower <- minWConstraints(data, spec, constraints) par.upper <- maxWConstraints(data, spec, constraints) if(DEBUG) print(rbind(par.lower, par.upper)) # Linear / Group Constraints: # ... targetReturn may be not defined,then set it to NA if (is.null(getTargetReturn(spec))) setTargetReturn(spec) <- NA # ... has in the first line the return constraint, if NA then ignore it eqsumW <- eqsumWConstraints(data, spec, constraints) if (is.na(eqsumW[1, 1])) eqsumW = eqsumW[-1, , drop= FALSE] Aeqsum <- eqsumW[, -1] aeqsum <- eqsumW[, 1] minsumW <- minsumWConstraints(data, spec, constraints) if (is.null(minsumW)) { Aminsum <- aminsum <- NULL } else { Aminsum <- minsumW[, -1] aminsum <- minsumW[, 1] } maxsumW <- maxsumWConstraints(data, spec, constraints) if (is.null(maxsumW)) { Amaxsum <- amaxsum <- NULL } else { Amaxsum <- maxsumW[, -1] amaxsum <- maxsumW[, 1] } A <- rbind(Aeqsum, Aminsum, Amaxsum) lin.lower <- c(aeqsum, aminsum, rep(-Inf, length(amaxsum))) lin.upper <- c(aeqsum, rep(Inf, length(aminsum)), amaxsum) if(DEBUG) print(cbind(lin.lower, A, lin.upper)) # Nonlinear Constraints - Here Covariance Risk Budgets: nlin <- list() nlin.lower <- NULL nlin.upper <- NULL # Check Constraints Strings for Risk Budgets: # Example: constraints = c("minB[2:3]=0.1", "maxB[3:5]=0.9") validStrings <- c("minB", "maxB") usedStrings <- unique(sort(sub("\\[.*", "", constraints))) checkStrings <- sum(usedStrings %in% validStrings) includeRiskBudgeting <- as.logical(checkStrings) if (DEBUG) print(includeRiskBudgeting) if (includeRiskBudgeting) { # Compose Non-Linear (Cov Risk Budget) Constraints Functions: nlcon <- function(x) { B1 <- as.vector(x %*% Sigma %*% x) B2 <- as.vector(x * Sigma %*% x) B <- B2/B1 B } if(DEBUG) print(nlcon) # Compose non-linear functions now for each asset ... for (I in 1:nAssets) eval( parse(text = paste( "nlcon", I, " = function(x) { nlcon(x)[", I, "] }", sep = "")) ) nlinFunctions <- paste("nlcon", 1:nAssets, sep = "", collapse = ",") nlinFunctions <- paste("list(", nlinFunctions, ")") nlin <- eval( parse(text = nlinFunctions) ) if(DEBUG) print(nlin) # ... and finally Compose Constraints Vectors: nlin.lower <- minBConstraints(data, spec, constraints) nlin.upper <- maxBConstraints(data, spec, constraints) if(DEBUG) print(rbind(nlin.lower, nlin.upper)) } # General non-lin Portfolio Constraints: # ... todo: currently overwrites previous selection nlin <- listFConstraints(data, spec, constraints) if(DEBUG) print(nlin) nlin.lower <- minFConstraints(data, spec, constraints) nlin.upper <- maxFConstraints(data, spec, constraints) if(DEBUG) print(cbind(nlin.lower, nlin.upper)) # Return Value: list( par = rep(1/nAssets, nAssets), fn = fn, par.lower = par.lower, par.upper = par.upper, A = A, lin.lower = lin.lower, lin.upper = lin.upper, nlin = nlin, nlin.lower = nlin.lower, nlin.upper = nlin.upper) } ################################################################################ fPortfolio/R/mathprogQP-neos.R0000644000175100001440000001740512323217770015776 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # rneosQP Rmetrics Interface for AMPL/NEOS QP solvers # neosQP Convenience wrapper for AMPL/NEOS QP solvers # neosQPControl NEOS QP ontrol parameter list ############################################################################### rneosQP <- function(objective, lower=0, upper=1, linCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Rmetrics Interface for AMPL/NEOS QP solvers # Arguments: # objective - list(dvec=NULL, Dmat = NULL) # FUNCTION: # Control List: ctrl <- neosQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Control Parameters: solver <- control$solver category <- control$category project <- control$project inf <- control$inf trace <- control$trace # General Settings: dvec <- objective$dvec Dmat <- objective$Dmat obj <- rbind(dvec, Dmat) # Box Constraints: replicate <- function(x, n) if(length(x) == 1) rep(x, n) else x n <- ncol(obj) x_L <- replicate(lower, n) x_U <- replicate(upper, n) x_L[is.infinite(x_L)] <- inf*sign(x_L[is.infinite(x_L)]) x_U[is.infinite(x_U)] <- inf*sign(x_U[is.infinite(x_U)]) # Linear Constraints: A <- linCons[[1]] m <- nrow(A) b_L <- replicate(linCons[[2]], m) b_U <- replicate(linCons[[3]], m) b_L[is.infinite(b_L)] <- inf*sign(b_L[is.infinite(b_L)]) b_U[is.infinite(b_U)] <- inf*sign(b_U[is.infinite(b_U)]) # Optimize Portfolio: value <- neosQP(objective, x_L, x_U, A, b_L, b_U, control) # Return Value: value } ############################################################################### neosQP <- function( objective=list(dvec=NULL, Dmat=NULL), x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list(), ...) { # A function implemented by Diethelm Wuertz # Description: # Convenience wrapper for AMPL/NEOS QP solvers # Arguments: # objective - list(dvec=NULL, Dmat = NULL) # FUNCTION: # Control List: ctrl <- neosQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Control Parameters: solver <- control$solver category <- control$category project <- control$project inf <- control$inf trace <- control$trace # Solver Settings: dvec <- objective$dvec Dmat <- objective$Dmat obj <- rbind(dvec, Dmat) n <- ncol(obj) m <- nrow(A) # Write AMPL Model File: amplModelOpen(project) model <- c( "param n ;", "param m ;", "param c{1..n} ;", "param F{1..n, 1..n} ;", "param x_L{1..n} ;", "param x_U{1..n} ;", "param A{1..m, 1..n} ;", "param b_L{1..m} ;", "param b_U{1..m} ;", "var x{1..n};", "minimize Risk: sum {i in 1..n} x[i]*c[i] + 0.5*sum {i in 1..n} sum{j in 1..n} x[i]*F[i,j]*x[j] ;", "s.t. lower {i in 1..n}: x[i] >= x_L[i] ;", "s.t. upper {i in 1..n}: x[i] <= x_U[i] ;", "s.t. linLower {j in 1..m}: sum{i in 1..n} A[j, i]*x[i] >= b_L[j] ;", "s.t. linUpper {j in 1..m}: sum{i in 1..n} A[j, i]*x[i] <= b_U[j] ;", NULL) amplModelAdd(model, project) if (trace) amplModelShow(project) # Write AMPL Data File: amplDataOpen(project) amplDataAddValue (data="n", value=n, project) amplDataAddValue (data="m", value=m, project) amplDataAddVector(data="c", vector=dvec, project) amplDataAddMatrix(data="F", matrix=Dmat, project) amplDataAddVector(data="x_L", vector=x_L, project) amplDataAddVector(data="x_U", vector=x_U, project) amplDataAddMatrix(data="A", matrix=A, project) amplDataAddVector(data="b_L", vector=b_L, project) amplDataAddVector(data="b_U", vector=b_U, project) if (trace) amplDataShow(project) # Write AMPL/NEOS RUN File: amplRunOpen(project) run <- c( "solve ;", "display x;", "display solve_result_num;", "display solve_result;", "display solve_message;", "exit ;") amplRunAdd(run, project) if (trace) amplRunShow(project) # Get AMPL Files: model <- paste(readLines( paste(project, "mod", sep=".")), sep = " ", collapse ="\n") data <- paste(readLines( paste(project, "dat", sep=".")), sep = " ", collapse ="\n") run <- paste(readLines( paste(project, "run", sep=".")), sep = " ", collapse ="\n") # Setup NEOS and AMPL Specifications: amplSpec <- list(model=model, data=data, commands=run, comments="NEOS") solverTemplate <- rneos::NgetSolverTemplate( category=category, solvername=solver, inputMethod="AMPL") xmls <- rneos::CreateXmlString( neosxml=solverTemplate, cdatalist=amplSpec) # Submit and Fetch NEOS Job: submittedJob <- rneos::NsubmitJob( xmlstring=xmls, user="rneos", interface="", id=0) ans <- rneos::NgetFinalResults(obj=submittedJob, convert=TRUE) out <- strsplit(ans@ans, split="\n")[[1]] # Get Weights: Index <- (grep("x .*. :=", out)+1):( grep("^;$", out)-1) Out <- out[Index] splits <- strsplit(paste(Out, collapse=" "), " ")[[1]] solution <- as.numeric(splits[splits != ""])[seq(2, 2*n, by=2)] Index <- as.numeric(splits[splits != ""])[seq(1, 2*n, by=2)] solution[Index] <- solution # Get Status: status <- strsplit(out[grep("solve_result", out)], split=" ") statusCode <- status[[1]][3] statusMessage <- status[[2]][3] # Get Solver Message: Index <- grep("solve_message", out):length(out) message <- out[Index] # Neos Job Version: version <- out[1] # Compute Obective Function Value: objval <- (dvec %*% solution + 0.5 * solution %*% Dmat %*% solution)[[1, 1]] # Return Value: model <- capture.output(amplModelShow(project)) run <- capture.output(amplRunShow(project)) value = list( opt = list(solve=ans, model=model, run=run, out=out), solution = solution, objective = objval, status = statusCode, message = statusMessage, solver = paste("AMPL", solver), version = version) class(value) <- c("solver", "list") value } # ----------------------------------------------------------------------------- neosQPControl <- function(solver="ipopt", category="nco", project="neos", inf=1e12, trace=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns control parameter list # FUNCTION: # Control Parameter: control <- list( solver=solver, category=category, project=project, inf=inf, trace=trace) # Return Value: control } ############################################################################### fPortfolio/R/object-getPortfolio.R0000644000175100001440000002350712424415120016662 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # getData Extracts data slot # getSeries Extracts assets series data # getNAssets Extracts number of assets from data # getUnits Extracts assets names from data # getStatistics Extracts statistics slot # getMean Extracs mean from statistics # getCov Extracs covariance Sigma from statistics # getMu Extracs mu from statistics # getSigma Extracs Sigma from statistics # getEstimator Extracts estimator from # getTailRisk Extracts tailRisk slot # FUNCTION: DESCRIPTION: # getSpec Extracs specification Slot # getType Extracts type of portfolio # getOptimize Extracts what to optimize of portfolio # getEstimator Extracts mean-covariance estimator # getParams Extracts optional parameter list # getAlpha Extracts target VaR-alpha specification # getA Extracts quadratic LPM exponent specification # getPortfolio Extract portfolio slot # getWeights Extracts weights from a portfolio object # getTargetReturn Extracts target return from specification # getTargetRisk Extracts target riks from specification # getRiskFreeRate Extracts risk free rate from specification # getNFrontierPoints Extracts number of frontier points # getStatus Extracts portfolio status information # getOptim Extract optim slot # getSolver Extracts solver from specification # getObjective Extracts objective # getOptions Extracts optimization options # getControl Extracts solver control options # getTrace Extracts solver's trace flag # FUNCTION: DESCRIPTION: # getConstraints Extracts weight constraints # FUNCTION: DESCRIPTION: # getCovRiskBudgets Extracts covariance risk budgets # getTailRiskBudgets Extracts tail risk budgets ################################################################################ # Extract from data slot of an object of class fPORTFOLIO: getData.fPORTFOLIO <- function(object) object@data getSeries.fPORTFOLIO <- function(object) object@data@data$series getNAssets.fPORTFOLIO <- function(object) object@data@data$nAssets getUnits.fPORTFOLIO <- function(x) x@data@data$names getStatistics.fPORTFOLIO <- function(object) object@data@statistics getMean.fPORTFOLIO <- function(object) object@data@statistics$mean getCov.fPORTFOLIO <- function(object) object@data@statistics$Cov getEstimator.fPORTFOLIO <- function(object) object@data@statistics$estimator getMu.fPORTFOLIO <- function(object) object@data@statistics$mu getSigma.fPORTFOLIO <- function(object) object@data@statistics$Sigma # ------------------------------------------------------------------------------ # Extract from spec slot of an object of class fPORTFOLIO: getSpec.fPORTFOLIO <- function(object) object@spec getModel.fPORTFOLIO <- function(object) object@spec@model getType.fPORTFOLIO <- function(object) object@spec@model$type getOptimize.fPORTFOLIO <- function(object) object@spec@model$optimize getEstimator.fPORTFOLIO <- function(object) object@spec@model$estimator getTailRisk.fPORTFOLIO <- function(object) object@spec@model$tailRisk getParams.fPORTFOLIO <- function(object) object@spec@model$params getAlpha.fPORTFOLIO <- function(object) object@spec@model$params$alpha getA.fPORTFOLIO <- function(object) object@spec@model$params$a # DW object@spec renamed to object@portfolio getPortfolio.fPORTFOLIO <- function(object) object@portfolio@portfolio getWeights.fPORTFOLIO <- function(object) object@portfolio@portfolio$weights getTargetReturn.fPORTFOLIO <- function(object) object@portfolio@portfolio$targetReturn getTargetRisk.fPORTFOLIO <- function(object) object@portfolio@portfolio$targetRisk getRiskFreeRate.fPORTFOLIO <- function(object) object@spec@portfolio$riskFreeRate getNFrontierPoints.fPORTFOLIO <- function(object) object@spec@portfolio$nFrontierPoints getStatus.fPORTFOLIO <- function(object) object@spec@portfolio$status getOptim.fPORTFOLIO <- function(object) object@spec@optim getSolver.fPORTFOLIO <- function(object) object@spec@optim$solver getObjective.fPORTFOLIO <- function(object) object@spec@optim$objective getOptions.fPORTFOLIO <- function(object) object@spec@optim$options getControl.fPORTFOLIO <- function(object) object@spec@optim$control getTrace.fPORTFOLIO <- function(object) object@spec@optim$trace getCovRiskBudgets.fPORTFOLIO <- function(object) object@portfolio@portfolio$covRiskBudgets # ------------------------------------------------------------------------------ # Extract from constraints slot of an object of class fPORTFOLIO: getConstraints.fPORTFOLIO <- function(object) object@constraints@stringConstraints getConstraintsTypes <- function(object) { Constraints = getConstraints(object) Types = NULL if(!is.na(pmatch("LongOnly", Constraints))) Types = c(Types, "LongOnly") if(!is.na(pmatch("Short", Constraints))) Types = c(Types, "Short") if(!is.na(pmatch("minW", Constraints))) Types = c(Types, "minW") if(!is.na(pmatch("maxW", Constraints))) Types = c(Types, "maxW") if(!is.na(pmatch("minsumW", Constraints))) Types = c(Types, "minsumW") if(!is.na(pmatch("maxsumW", Constraints))) Types = c(Types, "maxsumW") if(!is.na(pmatch("minB", Constraints))) Types = c(Types, "minB") if(!is.na(pmatch("maxB", Constraints))) Types = c(Types, "maxB") Types } ################################################################################ .getCovRiskBudgets.fPORTFOLIO <- function (object) { # A function implemented by Rmetrics # Description: # Extracts risk budgets from a portfolio object # FUNCTION: # Covariance Risk Budgets: weights = object@portfolio$weights ans = NA Sigma = object@data$data@statistics$Sigma if (is.null(dim(weights))) { # Single Portfolio ... ans1 = as.vector(weights %*% Sigma %*% weights) ans2 = as.vector(weights * Sigma %*% weights) ans = round(ans2/ans1, digits = 4) names(ans) = names(weights) } else { # Frontier ... Names = colnames(weights) ans = NULL for (i in 1:(dim(weights)[1])) { ans1 = as.vector(weights[i, ] %*% Sigma %*% weights[i, ]) ans2 = as.vector(weights[i, ] * Sigma %*% weights[i, ]) ans = rbind(ans, ans2/ans1) } colnames(ans) = Names } # Return Value: ans } # ------------------------------------------------------------------------------ getTailRiskBudgets.fPORTFOLIO <- function (object) { # A function implemented by Rmetrics # Description: # Extracts tail risk budgets from a portfolio object # Arguments: # object - an object of S4 class fPORTFOLIO as returned by the # functions *Portfolio(). # FUNCTION: # Check if available: Lambda = object@spec@model$tailRisk$lower if (is.null(Lambda)) return(NA) # Tail Risk Budgets: weights = getWeights(object) ans = NA if (is.null(dim(weights))) { ans1 = as.vector(weights %*% Lambda %*% weights) ans2 = as.vector(weights * Lambda %*% weights) ans1 = 1 ans = round(ans2/ans1, digits = 4) names(ans) = names(weights) } else { Names = colnames(weights) ans = NULL for (i in 1:(dim(weights)[1])) { ans1 = as.vector(weights[i, ] %*% Lambda %*% weights[i, ]) ans2 = as.vector(weights[i, ] * Lambda %*% weights[i, ]) ans1 = 1 ans = rbind(ans, ans2/ans1) } colnames(ans) = Names } # Return Value: ans } ################################################################################ fPortfolio/R/portfolio-efficientPfolio.R0000644000175100001440000002642012323217770020067 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # efficientPortfolio Returns a frontier portfolio # maxratioPortfolio Returns the max return/risk ratio portfolio # tangencyPortfolio Returns the tangency portfolio # minriskPortfolio Returns the minimum risk portfolio # minvariancePortfolio Returns the minimum variance portfolio # maxreturnPortfolio Returns the maximum return portfolio ################################################################################ efficientPortfolio <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Computes target risk and weights for an efficient portfolio # Arguments: # data - a rectangular object of assets # spec - an object of class 'fPFOLIOSPEC' # constraints - a character vector or NULL # Example: # data = as.timeSeries(data(LPP2005REC))[, 1:6] # spec = portfolioSpec(); setTargetReturn(spec) <- mean(data) # efficientPortfolio(data, spec) # FUNCTION: # Match Spec Versus Constraints: # .checkSpecVsConstraints(spec, constraints) # Optimize Portfolio: Solver <- match.fun(getSolver(spec)) portfolio <- Solver(data, spec, constraints) # Set Parameters: # Do not use ... # setWeights(spec) = portfolio$weights # setTargetReturn(spec) = portfolio$targetReturn # setTargetRisk(spec) = portfolio$targetRisk # to provide overwriting use: spec@portfolio$weights <- portfolio$weights spec@portfolio$targetReturn <- portfolio$targetReturn spec@portfolio$targetRisk <- portfolio$targetRisk # Add Status: setStatus(spec) <- portfolio$status # Add Title: Title <- "Efficient Portfolio" # Compose Portfolio: portfolio <- feasiblePortfolio(data, spec, constraints) portfolio@call <- match.call() portfolio@title <- Title # Return Value: portfolio } # ------------------------------------------------------------------------------ maxratioPortfolio <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Computes Capital Market Line # Arguments: # data - a rectangular object of assets # spec - an object of class 'fPFOLIOSPEC' # constraints - a character vector or NULL # Example: # data <- as.timeSeries(data(LPP2005REC))[, 1:6] # maxratioPortfolio(data) # FUNCTION: # Match Spec Versus Constraints: # .checkSpecVsConstraints(spec, constraints) # Transform Data: Data <- portfolioData(data, spec) # Compute Sharpe ratio to be minimized: ratioFun <- function(x, data, spec, constraints) { # x is the target return ... setTargetReturn(spec) <- x[1] Solver <- match.fun(getSolver(spec)) ans <- Solver(data, spec, constraints) # 2012-02-21 DW: Return if Solver does not converge BIG <- 1e10 if(ans$status != 0) return(-BIG) ratio = (x[1] - getRiskFreeRate(spec)) / ans$objective attr(ratio, "weights") <- ans$weights attr(ratio, "status") <- ans$status return(ratio) } # Start Solution - Equal Weights Portfolio: nAssets <- getNAssets(Data) setWeights(spec) <- rep(1/nAssets, times = nAssets) fp <- feasiblePortfolio(Data, spec, constraints) setTargetReturn(spec) <- getTargetReturn(fp) ## 2012-03-10 DW: ## tol = 10*.Machine$double.eps - higher tolerance added portfolio <- optimize(f = ratioFun, interval = range(getMu(Data)), maximum = TRUE, data = Data, spec = spec, constraints = constraints, tol = 10*.Machine$double.eps) ## 2009-04-19 DW: ## It may happen, that the maximum ratio portfolio cannot be computed. ## One reason is that the portfolio does not exist since the constraints ## are too restrictive. ## Another reason is that the risk free rate is above the highest return ## point. ## In these cases we stop the computation here, and return an error message. STATUS = attr(portfolio$objective, "status") if (STATUS != 0) { # Error Message: cat("\nExecution stopped:") cat("\n The maximum ratio portfolio could not be computed.") cat("\nPossible Reason:") cat("\n Your portfolio constraints may be too restrictive.") cat("\nStatus Information:") cat("\n status=", STATUS, " from solver ", getSolver(spec), ".", sep = "") cat("\n") stop(call. = FALSE, show.error.messages = "\n returned from Rmetrics") } # Continue: Succesfully computed the minimum risk portfolio ... setWeights(spec) <- attr(portfolio$objective, "weights") setStatus(spec) <- attr(portfolio$objective, "status") # Compose Portfolio: portfolio <- feasiblePortfolio(data, spec, constraints) portfolio@call <- match.call() portfolio@title <- "Max Return/Risk Ratio Portfolio" # Return Value: portfolio } # ------------------------------------------------------------------------------ tangencyPortfolio <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Computes Markowitz tangency portfolio # Arguments: # data - a rectangular object of assets # spec - an object of class 'fPFOLIOSPEC' # constraints - a character vector or NULL # FUNCTION: # Portfolio: portfolio <- maxratioPortfolio(data, spec, constraints) portfolio@title <- "Tangency Portfolio" # Return Value: portfolio } ################################################################################ .minriskPortfolio <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Computes minimum risk portfolio # Arguments: # data - a rectangular object of assets # spec - an object of class 'fPFOLIOSPEC' # constraints - a character vector or NULL # Example: # minriskPortfolio(SWX[, 1:3]) # FUNCTION: # Match Spec Versus Constraints: # .checkSpecVsConstraints(spec, constraints) # Transform Data: Data <- portfolioData(data, spec) # Compute target risk to be minimized: targetRiskFun <- function(x, data, spec, constraints) { # x is the target return ... setTargetReturn(spec) = x[1] Solver <- match.fun(getSolver(spec)) ans <- Solver(data, spec, constraints) targetRisk <- ans$objective attr(targetRisk, "weights") <- ans$weights attr(targetRisk, "status") <- ans$status return(targetRisk) } # Minimal Risk: portfolio <- optimize(targetRiskFun, interval = range(getMu(Data)), data = Data, spec = spec, constraints = constraints, tol = .Machine$double.eps^0.5) ## 2009-04-19 DW: ## It may happen, that the minimum risk protfolio cannot be computed. ## One reason is that the portfolio does not exist since the constraints ## are too restrictive. ## In this case we stop the computation here, and return an error message. STATUS = attr(portfolio$objective, "status") if (STATUS != 0) { # Error Message: cat("\nExecution stopped:") cat("\n The minimum risk portfolio could not be computed.") cat("\nPossible Reason:") cat("\n Your portfolio constraints may be too restrictive.") cat("\nStatus Information:") cat("\n status=", STATUS, " from solver ", getSolver(spec), ".", sep = "") cat("\n") stop(call.= FALSE, show.error.messages = "\n returned from Rmetrics") } # Continue: Succesfully computed the minimum risk portfolio ... setWeights(spec) <- attr(portfolio$objective, "weights") setStatus(spec) <- attr(portfolio$objective, "status") # Compose Portfolio: portfolio <- feasiblePortfolio(data, spec, constraints) portfolio@call <- match.call() portfolio@title <- "Minimum Risk Portfolio" # Return Value: portfolio } minriskPortfolio <- function(data, spec = portfolioSpec(), constraints = "LongOnly") { # A function implemented by Diethelm Wuertz # Note: # NEW VERSION DW # FUNCTION: setTargetReturn(spec) <- NULL portfolio <- efficientPortfolio(data, spec, constraints) portfolio@call <- match.call() portfolio@title <- "Minimum Risk Portfolio" # Return Value: portfolio } # ------------------------------------------------------------------------------ minvariancePortfolio <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Computes global minimum variance portfolio # Arguments: # data - a rectangular object of assets # spec - an object of class 'fPFOLIOSPEC' # constraints - a character vector or NULL # FUNCTION: # Portfolio: portfolio <- minriskPortfolio(data, spec, constraints) portfolio@title <- "Minimum Variance Portfolio" # Return Value: portfolio } ################################################################################ maxreturnPortfolio <- function(data, spec=portfolioSpec(), constraints="LongOnly") { # A function implemented by Diethelm Wuertz # Description: # Computes target risk and weights for an efficient portfolio # Arguments: # data - a rectangular object of assets # spec - an object of class 'fPFOLIOSPEC' # constraints - a character vector or NULL # FUNCTION: # Match Spec Versus Constraints: # .checkSpecVsConstraints(spec, constraints) # Transform Data: data = portfolioData(data, spec) # Maximize Return: if(is.null(getTargetRisk(spec))) { stop("Missing target risk for maximum return optimization.") } else { # Optimize Portfolio: Solver = match.fun(getSolver(spec)) portfolio = Solver(data, spec, constraints) setWeights(spec) = portfolio$weights setStatus(spec) = portfolio$status Title = "Return Maximized Efficient Portfolio" } # Compose Portfolio: portfolio <- feasiblePortfolio(data, spec, constraints) portfolio@call <- match.call() portfolio@title <- Title # Return Value: portfolio } ################################################################################ fPortfolio/R/solve-RglpkVAR.R0000644000175100001440000001602612323217770015526 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRglpk.CVAR Portfolio interface to solver Rglpk # .cvarRglpkArguments Returns CVAR arguments for solver # FUNCTION: DESCRIPTION: # .rglpk.CVAR Wrapper to solver function ################################################################################ solveRglpk.CVAR <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Portfolio interface to solver Rglpk # FUNCTION: # Settings: Data <- portfolioData(data, spec) data <- getSeries(Data) nAssets <- getNAssets(Data) type <- getType(spec) # Compile Arguments for Solver: args <- .cvarRglpkArguments(Data, spec, constraints) # Solve Multiassets Portfolio: ans <- .rglpk.CVAR( obj = args$obj, mat = args$mat, dir = args$dir, rhs = args$rhs, types = args$types, max = args$max, bounds = args$bounds, verbose = args$verbose, nScenarios = args$nScenarios, nAssets = args$nAssets, targetReturn = args$targetReturn, Alpha = args$Alpha, Type = args$Type) ans$solver <- "solveRglpk.CVAR" # Return Value: class(ans) = c("solver", "list") ans } ################################################################################ .cvarRglpkArguments <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Returns glpk conform CVaR arguments for the solver # Details: # max/min: obj %*% x # subject to: # mat %*% x ?= rhs # dir = "?=" # upper/lower bounds # # .Rglpk_solve_LP(obj, mat, dir, rhs, types = NULL, max = FALSE, # bounds = NULL, verbose = FALSE) # FUNCTION: # Settings: Data <- portfolioData(data, spec) data <- getSeries(Data) nAssets <- ncol(data) nScenarios <- nrow(data) targetReturn <- getTargetReturn(spec) Alpha <- getAlpha(spec) Type <- getType(spec) # Objective Function: objNames <- c("VaR", paste("e", 1:nScenarios, sep = ""), colnames(data)) obj <- c(1, -rep(1/(Alpha*nScenarios), nScenarios), rep(0, nAssets)) names(obj) <- objNames # The A_equal Equation Constraints: A_eq %*% x == a_eq eqsumW <- eqsumWConstraints(Data, spec, constraints) Aeq <- cbind( matrix(0, ncol=1+nScenarios, nrow=nrow(eqsumW)), matrix(eqsumW[, -1], ncol=nAssets) ) aeq <- eqsumW[, 1] deq <- rep("==", nrow(eqsumW)) # The VaR Equation Constraints: # (-1 + diag + Returns) %*% (VaR, es, W) >= 0 Avar <- cbind( matrix(rep(-1, nScenarios), ncol = 1), diag(nScenarios), getDataPart(getSeries(Data)) ) avar <- rep(0, nrow(Avar)) dvar <- rep(">=", nrow(Avar)) # The e_s > = 0 Equation Constraints: Aes <- cbind( matrix(rep(0, nScenarios), ncol = 1), diag(nScenarios), matrix(0, nrow = nScenarios, ncol = nAssets) ) aes <- rep(0, nrow(Aes)) des <- rep(">=", nrow(Aes)) # Group Constraints: A W >= a minsumW <- minsumWConstraints(Data, spec, constraints) if (is.null(minsumW)){ Aminsum <- aminsum <- dminsum <- NULL } else { Aminsum <- cbind( matrix(0, nrow = nrow(minsumW), ncol = 1+nScenarios), minsumW[, -1, drop = FALSE] ) aminsum <- minsumW[, 1] dminsum <- rep(">=", nrow(minsumW)) } # Group Constraints: A W <= b maxsumW <- maxsumWConstraints(Data, spec, constraints) if (is.null(maxsumW)){ Amaxsum <- amaxsum <- dmaxsum <- NULL } else { Amaxsum <- cbind( matrix(0, nrow = nrow(maxsumW), ncol = 1+nScenarios), maxsumW[, -1, drop = FALSE] ) amaxsum <- maxsumW[, 1] dmaxsum <- rep("<=", nrow(maxsumW)) } # Putting all together: mat <- rbind(Aeq, Avar, Aes, Aminsum, Amaxsum) rhs <- c(aeq, avar, aes, aminsum, amaxsum) dir <- c(deq, dvar, des, dminsum, dmaxsum) # Box Constraints: Upper and Lower Bounds as listn required ... minW <- minWConstraints(Data, spec, constraints) maxW <- maxWConstraints(Data, spec, constraints) nInd <- 1:(1+nScenarios+nAssets) bounds <- list( lower = list(ind = nInd, val = c(rep(-Inf, 1+nScenarios), minW)), upper = list(ind = nInd, val = c(rep( Inf, 1+nScenarios), maxW)) ) # What variable Types, All Continuous: types <- NULL # Should I minimize or maximize ? max <- TRUE # Return Value: list( obj = obj, mat = mat, dir = dir, rhs = rhs, types = types, max = max, bounds = bounds, verbose = FALSE, nScenarios = nScenarios, nAssets = nAssets, targetReturn = targetReturn, Alpha = Alpha, Type = Type) } ################################################################################ .rglpk.CVAR <- function(obj, mat, dir, rhs, types, max, bounds, verbose, nScenarios, nAssets, targetReturn, Alpha, Type) { # A function implemented by Diethelm Wuertz # Description: # Rglpk CVAR Solver # FUNCTION: # Solve - use Rglpk_solve_LP: optim <- Rglpk::Rglpk_solve_LP( obj = obj, mat = mat, dir = dir, rhs = rhs, types = types, max = max, bounds = bounds, verbose = verbose) # Extract Weights: weights <- .checkWeights(rev(rev(optim$solution)[1:nAssets])) attr(weights, "invest") = sum(weights) # Result: ans <- list( type = Type, solver = "Rglpk.CVAR", optim = optim, weights = weights, solution = weights, targetReturn = targetReturn, targetRisk = -optim$optimum, objective = -optim$optimum, status = optim$status[[1]], message = "NA") # Return Value: ans } ################################################################################ fPortfolio/R/solve-Rquadprog.R0000644000175100001440000001326612323217770016045 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRquadprog Portfolio interface to solver Rquadprog # .rquadprogArguments Returns arguments for solver # .rquadprog Wrapper to solver function ################################################################################ solveRquadprog <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Portfolio interface to solver Rquadprog # FUNCTION: # Transform Data: Data <- portfolioData(data, spec) data <- getSeries(Data) nAssets <- getNAssets(Data) # Compile Arguments for Solver: args <- .rquadprogArguments(Data, spec, constraints) # Solve Multiassets Portfolio: ans <- .rquadprog( Dmat = args$Dmat, dvec = args$dvec, Amat = args$Amat, bvec = args$bvec, meq = args$meq) # Save Arguments: ans$optim$args <- args # class: class(ans) = c("solver", "list") # Return Value: ans } ################################################################################ .rquadprogArguments <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Returns quadprog conform arguments for the solver # FUNCTION: # Data and Constraints as S4 Objects: Data <- portfolioData(data, spec) data <- getSeries(Data) Sigma <- getSigma(Data) nAssets <- getNAssets(Data) # Set up A_mat of Constraints: eqsumW <- eqsumWConstraints(Data, spec, constraints) minsumW <- minsumWConstraints(Data, spec, constraints) maxsumW <- maxsumWConstraints(Data, spec, constraints) Amat = rbind(eqsumW[, -1], diag(nAssets), -diag(nAssets)) if(!is.null(minsumW)) Amat = rbind(Amat, minsumW[, -1]) if(!is.null(maxsumW)) Amat = rbind(Amat, -maxsumW[, -1]) # Set up Vector A_mat >= bvec of Constraints: minW <- minWConstraints(Data, spec, constraints) maxW <- maxWConstraints(Data, spec, constraints) bvec <- c(eqsumW[, 1], minW, -maxW) if(!is.null(minsumW)) bvec = c(bvec, minsumW[, 1]) if(!is.null(maxsumW)) bvec = c(bvec, -maxsumW[, 1]) # Part (meq=1) or Full (meq=2) Investment, the Default ? meq <- nrow(eqsumW) # Directions: dir <- c( rep("==", times = meq), rep(">=", times = length(bvec) - meq)) # Return Value: list( Dmat = Sigma, dvec = rep(0, nAssets), Amat = t(Amat), bvec = bvec, meq = meq, dir = dir) } ################################################################################ .rquadprog <- function(Dmat, dvec, Amat, bvec, meq) { # A function implemented by Diethelm Wuertz # Description: # Goldfarb and Idnani's quadprog solver function # Note: # Requires to load contributed R package quadprog from which we use # the Fortran subroutine of the quadratic solver. # Package: quadprog # Title: Functions to solve Quadratic Programming Problems. # Author: S original by Berwin A. Turlach # R port by Andreas Weingessel # Maintainer: Andreas Weingessel # Description: This package contains routines and documentation for # solving quadratic programming problems. # License: GPL-2 # Value of slove.QP(): # solution - vector containing the solution of the quadratic # programming problem. # value - scalar, the value of the quadratic function at the # solution # unconstrained.solution - vector containing the unconstrained # minimizer of the quadratic function. # iterations - vector of length 2, the first component contains # the number of iterations the algorithm needed, the second # indicates how often constraints became inactive after # becoming active first. vector with the indices of the # active constraints at the solution. # FUNCTION: # Optimize: optim <- try(quadprog::solve.QP(Dmat, dvec, Amat, bvec, meq), silent = TRUE) if (inherits(optim, "try-error")) { weights <- rep(0, length(dvec)) optim <- list() status <- 1 } else { # Set Tiny Weights to Zero: weights <- .checkWeights(optim$solution) attr(weights, "invest") = sum(weights) status <- 0 } # Compose Output List: ans <- list( type = "MV", solver = "solveRquadprog", optim = optim, weights = weights, targetReturn = bvec[1], targetRisk = sqrt(weights %*% Dmat %*% weights)[[1, 1]], objective = sqrt(weights %*% Dmat %*% weights)[[1, 1]], status = status, message = NA) # Return Value: ans } ################################################################################ fPortfolio/R/object-portfolioData.R0000644000175100001440000000613112323217770017017 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # portfolioData Returns an object of class fPFOLIODATA ################################################################################ portfolioData <- function(data, spec=portfolioSpec()) { # A function implemented by Rmetrics # Description: # Creates portfolio data list # Arguments: # data - a multivariate 'timeSeries' object # spec - a portfolio specification structure, from which # the mean and covariance type of estimator will be extracted # Details: # The first argument can be either: # 1) an object of class "fPFOLIODATA" # 2) an object of class "timeSeries" # 3) a "list: with portfolio mean and covariance # FUNCTION: # Data, if we have already an object of class "fPFOLIODATA": if (is(data, "fPFOLIODATA")) return(data) # Data, if we have a "timeSeries" or a "list": if (class(data) == "timeSeries") { series = data = sort(data) assetsNames = colnames(data) } else if (class(data) == "list") { series = rep(NA, times = length(data[[1]])) assetsNames = names(series) = names(data[[1]]) } nAssets = length(assetsNames) names = assetsNames if(is.null(names)) names = paste("A", 1:nAssets, sep = "") .data = list( series = series, nAssets = nAssets, names = assetsNames) # Statistics: if (class(data) == "timeSeries") { estimator = getEstimator(spec) estimatorFun = match.fun(estimator) muSigma = estimatorFun(data, spec) Cov = cov(data) rownames(Cov) <- colnames(Cov) <- names .statistics = list( mean = colMeans(data), Cov = Cov, estimator = estimator, mu = muSigma$mu, Sigma = muSigma$Sigma) } else if (class(data) == "list") { .statistics = list( mean = data[[1]], Cov = data[[2]], estimator = NA, mu = data[[1]], Sigma = data[[2]]) } # Tail Risk: .tailRisk = spec@model$tailRisk # Return Value: new("fPFOLIODATA", data = .data, statistics = .statistics, tailRisk = .tailRisk) } ################################################################################ fPortfolio/R/risk-surfaceRisk.R0000644000175100001440000003424512323217770016202 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # markowitzHull Hull for a long-only Markowitz portfolio # feasibleGrid Square grid on top of the feasible set # bestDiversification Diversified portfolios on top of the feasible set # riskSurface Risk values on top of the feasible set # surfacePlot Risk Suface Plot for a Markowitz portfolio # FUNCTION: DESCRIPTION: # .scaledColors Quantile color scaling ################################################################################ markowitzHull <- function (data, nFrontierPoints=50) { # Description: # Returns the Hull for a long-only Markowitz portfolio # Arguments: # data - an object of class 'timeSeries' # Example: # hull <- markowitzHull(100*LPP2005.RET[, 1:6], nFrontierPoints=11) # plot(hull[[1]], type="n"); polygon(hull[[1]], col="grey") # FUNCTION: # Check: stopifnot(is.timeSeries(data)) # Compute Frontier and Minimum Variance Locus: Spec <- portfolioSpec() setNFrontierPoints(Spec) <- nFrontierPoints frontier <- portfolioFrontier(data, spec=Spec) Risks <- risks <- frontierPoints(frontier)[, 1] Returns <- frontierPoints(frontier)[, 2] # Compute Maximum Variance Locus - Pairwise Assets Approach: N <- ncol(data) for (i in 1:(N - 1)) for (j in (i + 1):N) { Data <- data[, c(i, j)] ans <- portfolioFrontier(Data, spec=Spec) coord <- frontierPoints(ans) nextFrontier <- approx(coord[, 2], coord[, 1], xout = Returns)$y naIndex <- which(is.na(nextFrontier)) nextFrontier[naIndex] <- Risks[naIndex] risks <- rbind(risks, nextFrontier) } # Hull: targetReturn <- Returns minTargetRisk <- Risks maxTargetRisk <- colMaxs(risks) hull <- cbind( targetReturn = Returns, minTargetRisk = Risks, maxTargetRisk = colMaxs(risks)) # Polygon: polygon <- cbind( c(minTargetRisk, rev(maxTargetRisk)[-1]), c(targetReturn, rev(targetReturn)[-1]) ) rownames(polygon) <- 1:nrow(polygon) colnames(polygon) <- c("targetRisk", "targetReturn") # Return Value: ans <- polygon attr(ans, "data") <- data attr(ans, "hull") <- hull attr(ans, "frontier") <- frontier invisible(ans) } # ----------------------------------------------------------------------------- feasibleGrid <- function(hull, trace=FALSE) { # Description: # Returns best diversified portfolios on top of the feasible Set # Arguments: # hull - an object as returned from the function markowitzHull # trace - a logical, should the function be traced ? # Example: # hull <- markowitzHull(100*LPP2005.RET[, 1:6], nFrontierPoints=21) # grid <- feasibleGrid(hull, TRUE) # FUNCTION: # Data: polygon <- hull data <- attr(hull, "data") hull <- attr(hull, "hull") # Trace Hull: if (trace) { plot(polygon) box(col="white") polygon(polygon, col="grey") grid() } # Settings: minRisks <- as.vector(hull[, 2]) maxRisks <- as.vector(hull[, 3]) minRisk <- min(minRisks) maxRisk <- max(maxRisks) targetRisks <- seq(minRisk, maxRisk, length = length(minRisks)) targetReturns <- as.vector(hull[, 1]) N <- length(targetReturns) # Get Weights on Grid: Grid <- matrix(NA, ncol=N, nrow=N) offset <- diff(range(targetRisks[1:2]))/2 for (i in 1:N) { targetReturn <- targetReturns[i] for (j in 1:N) { targetRisk <- targetRisks[j] + offset if (targetRisk >= minRisks[i] && targetRisk <= maxRisks[i]) { Grid[j, i] <- 1 if (trace) points(targetRisk, targetReturn, pch=19) } } } # Return Value: ans <- list(x=targetRisks, y=targetReturns, z=Grid) attr(ans, "data") <- data attr(ans, "polygon") <- polygon attr(ans, "hull") <- hull class(ans) <- c("feasibleGrid", "list") invisible(ans) } # ----------------------------------------------------------------------------- bestDiversification <- function(grid, FUN="var", trace=FALSE) { # Description: # Returns best diversified portfolios on top of the feasible Set # Arguments: # data - an object of class 'timeSeries' # grid - an object of class 'feasibleGrid' # as returned by the function feasibleGid() # FUN - the divesification function, a function with # with the weights as its first argument # trace - a logical, should the function be traced ? # Example: # data <- 100*LPP2005.RET[, 1:6] # hull <- makowitzHull(data, nFrontierPoints=21) # grid <- feasibleGrid(hull, trace=TRUE) # diversification <- bestDiversification(grid, FUN=var) # FUNCTION: # Data: data <- attr(grid, "data") polygon <- attr(grid, "polygon") # Settings: targetRisks <- grid$x targetReturns <- grid$y Grid <- grid$z N <- length(targetRisks) objectiveFun <- match.fun(FUN) nAssets <- ncol(data) MEAN <- colMeans(data) COV <- cov(data) # Trace: if(trace) { image(grid, col="lightgrey") box(col="white") grid() } # Get Weights on Grid: Weights <- Coord <- NULL Objective <- NA * Grid Start <- rep(1/nAssets, times = nAssets) for (i in 1:N) { targetReturn <- targetReturns[i] for (j in 1:N) { targetRisk <- targetRisks[j] if (!is.na(Grid[j,i])) { ans <- donlp2NLP( start = Start, objective <- objectiveFun, par.lower = rep(0, times = nAssets), par.upper = rep(1, times = nAssets), eqA = rbind(rep(1, times = nAssets), MEAN), eqA.bound = c(1, targetReturn), eqFun = list(function(x) sqrt(t(x) %*% COV %*% x)), eqFun.bound = targetRisk) Weights <- rbind(Weights, ans$solution) Objective[j,i] <- objectiveFun(ans$solution) Coord <- rbind(Coord, c(j,i)) if(trace) { points(targetRisk, targetReturn, pch=19, cex=0.7) } } } } # Return Value: ans <- list(x=targetRisks, y=targetReturns, z=Objective) attr(ans, "data") <- data attr(ans, "polygon") <- polygon attr(ans, "weights") <- cbind(Coord, Weights) class(ans) <- c("bestDiversification", "list") invisible(ans) } # ----------------------------------------------------------------------------- riskSurface <- function(diversification, FUN=NULL, ...) { # Description: # Returns a risk values on top of the feasible set # Arguments: # diversification - an object of class class 'bestDiversification' # as returned by the function bestDiversification() # FUN - risk surface function having arguments # FUN(data, weights, ...) # ... - optional arguments passed to FUN # Example: # data <- 100*LPP2005.RET[, 1:6] # hull <- markowitzHull(data, nFrontierPoints=21) # grid <- feasibleGrid(hull, TRUE) # diversification <- bestDiversification(grid) # surface <- riskSurface(diversification) # FUNCTION: # Data and Weighs: data <- attr(diversification, "data") weights <- attr(diversification, "weights") polygon <- attr(diversification, "polygon") # Risk Function: if (is.null(FUN)) FUN <- function(data, weights, ...) var(weights) fun <- match.fun(FUN) # Grid: Coord <- attr(diversification, "weights")[, 1:2] Weights <- attr(diversification, "weights")[, -(1:2)] N <- nrow(Coord) x <- diversification$x y <- diversification$y z <- diversification$z # Risk Surface: Value <- NA * z for (k in 1:N) { Value[Coord[k, 1], Coord[k, 2]] <- fun(data, Weights[k, ], ...) } # Return Value: ans <- list(x=x, y=y, z=Value) attr(ans, "data") <- data attr(ans, "weights") <- weights attr(ans, "polygon") <- polygon class(ans) <- c("riskSurface", "list") ans } ############################################################################### surfacePlot <- function(surface, type=c("image", "filled.contour"), nlevels=11, palette=topo.colors, addContour=TRUE, addGrid=TRUE, addHull=TRUE, addAssets=TRUE, ...) { # Description: # Arguments: # surface - an object of class 'riskSurface' as # returned by the function riskSurface() # type - a character string denoting the plot type, # by default "image, alternatively "filledContour" # nlevels - integer, the number of countour levels # palette - color palette function # addCountour - a logical flag, should contour lines be added ? # addCountour - a logical flag, should contour lines be added ? # addGrid - a logical flag, should grid lines be added ? # addAssets - a logical flag, should assets points be added ? # ... - optional arguments passed to the function title() # Example: # data <- 100*LPP2005.RET[, 1:6] # hull <- markowitzHull(data) # grid <- feasibleGrid(hull, trace=TRUE) # diversification <- bestDiversification(grid, trace=TRUE) # surface <- riskSurface(diversification) # surfacePlot(surface) # surfacePlot(surface, type="f"); # title("Weights Diversification", xlab="Risk", ylab="Return") # FUNCTION: # Surface Points; x <- surface$x y <- surface$y z <- surface$z # Quantile Levels: colors <- .scaledColors(surface, palette=palette, nlevels=nlevels) levels <- colors$levels palette <- colors$palette # Contour overlayed Image Ranges: yOffset <- 0.025*diff(range(y)) yLim <- c(min(y)-yOffset, max(y)+yOffset) xOffset <- 0.1*diff(range(x)) xLim <- c(min(x)-xOffset/4, max(x)+xOffset) # Select Type: type <- match.arg(type) if (type == "image") { image(x, y, z, xlim=xLim, ylim=yLim, xlab="", ylab="", col=palette) box(col="white") } else if (type == "filled.contour") { image(x, y, z, xlim=xLim, ylim=yLim, xlab="", ylab="", col="white") # DW # .Internal(filledcontour()) no longer works on 3.0. # .Internal(filledcontour( # as.double(x), as.double(y), z, # as.double(levels), col = palette)) # Use instead: graphics::.filled.contour( x = as.double(x), y = as.double(y), z = z, levels = as.double(levels), col = palette) box(col="white") } # Add Contour Lines: if(addContour) contour(x, y, z, add=TRUE, levels=signif(levels, 3)) # Add Hull: if(addHull) { hull <- attr(surface, "polygon") lines(hull, lwd=2, col="darkgreen") } # Add Grid: if(addGrid) grid() # Add Optional Lables: title(...) # Add Legend: cs <- cumsum(levels) css <- ( cs - min(cs) ) / diff(range(cs)) css <- 0.95 * css + 0.025 cy <- min(y) + css * diff(range(y)) cx <- rep(xLim[2]-0.1 * xOffset, length(cy)) lines(cx, cy, lwd=3) for (i in 1:(nlevels-1)) lines(c(cx[i], cx[i+1]), c(cy[i], cy[i+1]), lwd=3, col=palette[i]) for (i in 1:nlevels) points(cx[i], cy[i], pch=16, cex=1.1, col="black") textOffset <- c(-0.0005, 0.0005, 0.0008, 0.0008, rep(0, 7)) text(cx, cy+textOffset, as.character(signif(levels, 2)), pos=2, cex=0.8) # Add Assets: if (addAssets) { frontier <- portfolioFrontier(data) pointCex <- 2.5 textCex <- 0.5 xy <- minvariancePoints(frontier, auto=FALSE, pch=19, cex=pointCex, col = "red") text(xy[, 1], xy[, 2], "MVP", font=2, col="white", cex=textCex) xy <- tangencyPoints(frontier, auto=FALSE, pch=19, cex=pointCex, col="orange") text(xy[, 1], xy[, 2], "TGP", font=2, col="white", cex=textCex) xy <- equalWeightsPoints(frontier, auto=FALSE, pch=19, cex=pointCex, col="brown") text(xy[, 1], xy[, 2], "EWP", font=2, col="white", cex=textCex) xy <- singleAssetPoints(frontier, auto=FALSE, pch=19, cex=pointCex, col="black", lwd=2) text(xy[, 1], xy[, 2], rownames(xy), font=2, col="white", cex=textCex) } # Return Value: invisible(list(surface=surface, levels=levels)) } # ------------------------------------------------------------------------------ .scaledColors <- function(surface, palette=topo.colors, nlevels=11) { # Description: # scales a color palette # Arguments: # surface - a list with x,y positions and z values # palette - color palette function # bin - quantile bin width of contour levels # FUNCTION: # Extract Surface Risk Values: Z <- as.vector(surface$z) # Scale by Equidistant Quantiles: levels <- quantile(Z, probs=seq(from=0, to=1, length=nlevels), na.rm=TRUE) # Compose Color Palette: palette <- palette(nlevels-1) # Return Value: list(palette=palette, levels=levels) } ############################################################################### fPortfolio/R/a-class-fPFOLIOSPEC.R0000644000175100001440000000235012323217770016075 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # 'fPFOLIOSPEC' S4 Portfolio Specification Class ################################################################################ setClass("fPFOLIOSPEC", representation( model = "list", portfolio = "list", optim = "list", messages = "list", ampl = "list") ) ################################################################################ fPortfolio/R/object-getPortfolioVal.R0000644000175100001440000000461712323217770017337 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # getPortfolio Extracts portfolio from value object # FUNCTION: DESCRIPTION: # getWeights Extracts weights from value object # getCovRiskBudgets Extracts covarisnce risk budgets value # getTargetReturn Extracts target return from value object # getTargetRisk Extracts target risk from value object # getAlpha Extracts CVaR alpha from value object # getRiskFreeRate Extracts risk free rate from value object # getNFrontierPoints Extracts number of frontier points value # getStatus Extracts status from value object ################################################################################ getPortfolio.fPFOLIOVAL <- function(object) object@portfolio getWeights.fPFOLIOVAL <- function(object) object@portfolio$weights getCovRiskBudgets.fPFOLIOVAL <- function(object) object@portfolio$covRiskBudgets getTargetReturn.fPFOLIOVAL <- function(object) object@portfolio$targetReturn getTargetRisk.fPFOLIOVAL <- function(object) object@portfolio$targetRisk getAlpha.fPFOLIOVAL <- function(object) object@portfolio$targetAlpha getRiskFreeRate.fPFOLIOVAL <- function(object) object@Portfolio$riskFreeRate getNFrontierPoints.fPFOLIOVAL <- function(object) object@portfolio$nFrontierPoints getStatus.fPFOLIOVAL <- function(object) object@portfolio$status ################################################################################ fPortfolio/R/utils-amplExec.R0000644000175100001440000000554712410245120015635 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # .amplExec Executes AMPL run file for a given project # .amplExample Optimizes mean variance portfolio example ############################################################################### .amplExec <- function(project="ampl") { # A function Implemented by Diethelm Wuertz # Description: # Executes AMPL run file for a given project. # Details: # Note the following files must exist: # [project].mod - the AMPL model file # [project].dat - the AMPL data file # [project].run - the AMPL run file # FUNCTION: # Execute run file: command <- paste("ampl -t -vs", paste(project, "run", sep=".")) solve <- system(command, intern=TRUE) # Print: cat(solve, sep="\n") # Return Value: invisible(solve) } # ----------------------------------------------------------------------------- .amplExample <- function() { # A function Implemented by Diethelm Wuertz # Description: # Optimizes mean variance portfolio example. # FUNCTION: # Load Dataset dataSet <- data("LPP2005REC", package="timeSeries", envir=environment()) LPP2005REC <- get(dataSet, envir=environment()) # Portfolio Data: nAssets <- 6 data <- 100 * LPP2005REC[, 1:nAssets] # Optimization Arguments: objective <- list(dvec=rep(0, nAssets), Dmat=cov(data)) lower <- 0 upper <- 1 linCons <- list( mat = rbind( budget = rep(1, times=nAssets), returns = colMeans(data)), lower = c( budget = 1, return = mean(data)), upper = c( budget = 1, return = mean(data))) control <- list() # Default - AMPL Interface: ampl <- ramplQP(objective, lower, upper, linCons, control) # Return Value: ampl } ############################################################################### fPortfolio/R/mathprogQP-quadprog.R0000644000175100001440000001563512323217770016657 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # rquadprogQP Rmetrics Interface for QUADPROG QP solvers # quadprogQP Convenience wrapper for QUADPROG QP solvers # quadprogQPControl QUADPROG QP control parameter list # rquadprog Synonyme name for quadprog::solveLP function ############################################################################### rquadprogQP <- function(objective, lower=0, upper=1, linCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Implements Goldberg-Idnani Algorithm # Arguments: # objective - list(dvec=NULL, Dmat=NULL) # lower - lower box constraints # upper - upper box constraints # linCons - linear constraints, list with entries: # mat, lower, upper. # control - control list # FUNCTION: # Control List: ctrl <- quadprogQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # General Settings: dvec <- objective$dvec Dmat <- objective$Dmat Names <- colnames(rbind(dvec, Dmat)) N <- ncol(rbind(dvec, Dmat)) # Box Constraints: if(length(lower) == 1) { par.lower <- rep(lower, N) } else { par.lower <- lower } if(length(upper) == 1) { par.upper <- rep(upper, N) } else { par.upper <- upper } # Linear Constraints: if(missing(linCons)) { eqA <- ineqA <- NULL eqA.bound <- ineqA.lower <- ineqA.upper <- NULL } else { mat <- linCons[[1]] M <- nrow(mat) lower <- linCons[[2]] upper <- linCons[[3]] if(length(lower) == 1) lower <- rep(lower, M) if(length(upper) == 1) upper <- rep(upper, M) eqIndex <- which(lower == upper) ineqIndex <- which(lower != upper) if (length(eqIndex) == 0) { eqA <- NULL eqA.bound <- NULL } else { eqA <- mat[eqIndex, ] eqA.bound <- lower[eqIndex] } if (length(ineqIndex) == 0) { ineqA <- NULL ineqA.lower <- NULL ineqA.upper <- NULL } else { ineqA <- mat[ineqIndex, ] ineqA.lower <- lower[ineqIndex] ineqA.upper <- upper[ineqIndex] } } # Optimize Portfolio: optim <- quadprogQP( objective, par.lower, par.upper, eqA, eqA.bound, ineqA, ineqA.lower, ineqA.upper, control) # Return Value: value <- list( opt = optim, solution = optim$solution, objective = optim$objective, status = optim$status, message = optim$message, solver = "quadprog", version = optim$version) class(value) = c("solver", "list") value } ############################################################################### quadprogQP <- function( objective=list(dvec=NULL, Dmat=NULL), par.lower=NULL, par.upper=NULL, eqA=NULL, eqA.bound=NULL, ineqA=NULL, ineqA.lower=NULL, ineqA.upper=NULL, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Implements Goldberg-Idnani Algorithm # FUNCTION: # Control List: ctrl <- quadprogQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # General Settings: dvec <- -objective$dvec Dmat <- objective$Dmat Names <- colnames(rbind(dvec, Dmat)) N <- ncol(rbind(dvec, Dmat)) # Box Constraints: if (length(par.lower) == 1) par.lower <- rep(par.lower, N) if (length(par.upper) == 1) par.upper <- rep(par.upper, N) # Constraints Settings: Amat <- eqA if (!is.null(ineqA)) Amat <- rbind(eqA, ineqA, -ineqA) Amat <- rbind(Amat, diag(N), -diag(N)) Amat <- t(Amat) bvec <- eqA.bound if (!is.null(ineqA.lower)) bvec <- c(bvec, ineqA.lower) if (!is.null(ineqA.upper)) bvec <- c(bvec, -ineqA.upper) bvec <- c(bvec, par.lower) if (!is.null(par.upper)) bvec <- c(bvec, -par.upper) if (is.null(eqA)) meq <- 0 else meq <- nrow(eqA) Amat <- Amat[, is.finite(bvec)] bvec <- bvec[is.finite(bvec)] # Optimize: elapsed <- Sys.time() optim <- quadprog::solve.QP( Dmat = Dmat, dvec = dvec, Amat = Amat, bvec = bvec, meq = meq) elapsed <- Sys.time() - elapsed # Note: # DW: if quadprog::solve.QP fails with non-zero status optim$ierr= # =1: stop("constraints are inconsistent, no solution!") # =2: stop("matrix D in quadratic function is not positive definite!") # this is ugly! # Thus: Status <- 0 Message <- "solution found" # Add: names(optim$solution) <- Names # Version: package <- packageDescription(pkg="quadprog") version <- paste(package$Package, package$Version, package$Date) # Return Value: value <- list( opt = optim, solution = optim$solution, objective = optim$value, status = Status, message = Message, solver = "quadprog", elapsed <- elapsed, version = version) class(value) = c("solver", "list") value } ############################################################################### rquadprog <- quadprog::solve.QP ############################################################################### quadprogQPControl <- function(solver="quadprog", trace=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns control parameter list # Arguments: # trace - al logical flag, should the function be traced? # Details: # Note there are no control paramters supported in # quadprog::solve.QP # FUNCTION: # Control Parameter: control <- list(trace = trace) # Return Value: control } ############################################################################### fPortfolio/R/plot-weightsPlots.R0000644000175100001440000005314312323217770016421 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # weightsPlot Plots staggered weights along the frontier # weightedReturnsPlot Plots staggered weighted returns # riskBudgetsPlot Plots general risk budgets # covRiskBudgetsPlot Plots covariance risk budgets # tailRiskBudgetsPlot Plots copulae tail risk budgets ################################################################################ weightsPlot <- function(object, labels=TRUE, col=NULL, title=TRUE, box=TRUE, legend=TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots a bar chart of weights along the frontier # Arguments: # object - an object of class 'fPORTFOLIO' # labels - should the graph be automatically labeled? # col - a color palette, by default the rainbow palette # title - should the graph get default title and labels? # legend - should a legend be added to the plot? # box - # ... - arguments passed to the function barplot() # Requires: # fBasics for seqPalette() # FUNCTION: # Check if we have a portfolio frontier ... weights <- getWeights(object@portfolio) if (is.null(dim(weights))) stop("The object is not a set of portfolios along the frontier.") # Use default color if not specified ... Title <- "Weights" if (is.null(col)) col <- seqPalette(getNAssets(object), "Blues") if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX <- 0.9 else CEX <- 0.7 # Compute Weights: pos.weights <- +0.5 * (abs(weights) + weights) neg.weights <- -0.5 * (abs(weights) - weights) # Define Plot Range: ymax <- max(rowSums(pos.weights)) ymin <- min(rowSums(neg.weights)) range <- ymax - ymin ymax <- ymax + 0.005 * range ymin <- ymin - 0.005 * range dim <- dim(weights) range <- dim[1] xmin <- 0 xmax <- range + 0.2 * range # Create Bar Plots: if (labels) { if(!legend){ barplot(t(pos.weights), col=col, space=0, ylab="", ylim=c(ymin, ymax), border="grey", ...) } else { barplot(t(pos.weights), col=col, space=0, ylab="", xlim=c(xmin, xmax), ylim=c(ymin, ymax), border="grey", ...) legendtext <- names(getStatistics(object)$mu) if(is.null(legendtext)){ for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")} } legend("topright", legend = legendtext, bty = "n", cex=0.7, fill = col) } barplot(t(neg.weights), col=col, space=0, add = TRUE, border="grey", ...) } else { barplot(t(pos.weights), col=col, ...) } # Add Tailored Labels - 6 may be a good Number ... targetRisk <- getTargetRisk(object@portfolio)[, 1] targetReturn <- getTargetReturn(object@portfolio)[, 1] nSigma <- length(targetRisk) nLabels <- 6 M <- c(0, ( 1:(nSigma %/% nLabels) ) ) * nLabels + 1 # Take a reasonable number of significant digits to plot, e.g. 2 ... nSignifDigits = 3 axis(3, at=M, labels=signif(targetRisk[M], nSignifDigits)) axis(1, at=M, labels=signif(targetReturn[M], nSignifDigits)) # Add Axis Labels and Title: if (title) { mtext("Target Risk", side=3, line=2, adj=1, cex=CEX) mtext("Target Return", side=1, line=2, adj=1, cex=CEX) mtext("Weight", side=2, line=2, adj=1, cex=CEX) } # Add Weights 0 and 1 Reference Lines lines(x=c(0, nSigma), c(1, 1), col="grey", lty=3) lines(x=c(0, nSigma), c(0, 0), col="grey", lty=3) # Add vertical Line at minimum risk: minIndex <- which.min(targetRisk) minRisk <- signif(min(targetRisk)) abline(v = minIndex, col="black", lty = 1, lwd = 2) # Add Title: if (title) mtext(Title, adj=0, line=2.5, font=2, cex=CEX+0.1) # Complete to draw Box: if (box) box() # Add Rmetrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") # Return Value: invisible(list(minRisk=minRisk)) } # ------------------------------------------------------------------------------ weightedReturnsPlot <- function(object, labels=TRUE, col=NULL, title=TRUE, box=TRUE, legend=TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots weighted returns # Arguments: # object - an object of class 'fPORTFOLIO' # labels - should the graph be automatically labeled? # col - a color palette, by default the rainbow palette # title - should the graph get default title and labels? # legend - should a legend be added to the plot? # FUNCTION: # Check if we have a portfolio frontier ... weights <- getWeights(object@portfolio) if (is.null(dim(weights))) stop("The object is not a set of portfolios along the frontier.") # Use default color if not specified ... Title <- "Weighted Returns" if (is.null(col)) col=seqPalette(getNAssets(object), "Blues") if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX <- 0.9 else CEX <- 0.7 # Compute Weighted Returns: dim <- dim(weights) returns <- getStatistics(object)$mu weightedReturns <- NULL for(i in 1:dim[2]){ nextWeightedReturns <- weights[,i]*returns[i] weightedReturns <- cbind(weightedReturns, nextWeightedReturns) } colnames(weightedReturns) = colnames(weights) pos.weightedReturns <- +0.5 * (abs(weightedReturns) + weightedReturns) neg.weightedReturns <- -0.5 * (abs(weightedReturns) - weightedReturns) # Define Plot Range: ymax <- max(rowSums(pos.weightedReturns)) ymin <- min(rowSums(neg.weightedReturns)) range <- ymax - ymin ymax <- ymax + 0.005 * range ymin <- ymin - 0.005 * range range <- dim[1] xmin <- 0 xmax <- range + 0.2 * range # Create Bar Plots: if (labels) { if(legend){ barplot(t(pos.weightedReturns), space=0, ylab="", xlim=c(xmin, xmax), ylim=c(ymin, ymax), col=col, border="grey", ...) legendtext <- names(getStatistics(object)$mu) if(is.null(legendtext)){ for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")} } legend("topright", legend = legendtext, bty = "n", cex=0.7, fill = col) } else { barplot(t(pos.weightedReturns), space=0, ylab="", ylim=c(ymin, ymax), col=col, border="grey", ...) } barplot(t(neg.weightedReturns), space=0, add = TRUE, col=col, border="grey", ...) } else { barplot(t(pos.weightedReturns), col=col, ...) } # Add Tailored Labels - 6 may be a good Number ... targetRisk <- getTargetRisk(object@portfolio)[, 1] targetReturn <- getTargetReturn(object@portfolio)[, 1] nSigma <- length(targetRisk) nLabels <- 6 M <- c(0, ( 1: (nSigma %/% nLabels) ) ) * nLabels + 1 # Take a reasonable number of significant digits to plot, e.g. 2 ... nSignifDigits = 3 axis(3, at=M, labels=signif(targetRisk[M], nSignifDigits)) axis(1, at=M, labels=signif(targetReturn[M], nSignifDigits)) # Add Axis Labels and Title: if (title) { mtext("Target Risk", side=3, line=2, adj=1, cex=CEX) mtext("Target Return", side=1, line=2, adj=1, cex=CEX) mtext("Weighted Return", side=2, line=2, adj=1, cex=CEX) } # Add Weights 0 and 1 Reference Lines lines(x=c(0, nSigma), c(1, 1), col="grey", lty=3) lines(x=c(0, nSigma), c(0, 0), col="grey", lty=3) # Add vertical Line at minimum risk: minIndex = which.min(targetRisk) minRisk = signif(min(targetRisk)) abline(v = minIndex, col="black", lty = 1, lwd = 2) # Add Title: if (title) mtext(Title, adj=0, line=2.5, font=2, cex=CEX+0.1) # Complete to draw Box: if (box) box() # Add Rmetrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") # Return Value: invisible() } # ------------------------------------------------------------------------------ covRiskBudgetsPlot <- function(object, labels=TRUE, col=NULL, title = TRUE, box = TRUE, legend = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots a bar chart of covariance risk budgets # Arguments: # object - an object of class 'fPORTFOLIO' # labels - should the graph be automatically labeled? # col - a color palette, by default the rainbow palette # title - should the graph get default title and labels? # legend - should a legend be added to the plot? # FUNCTION: # Settings: mtext <- TRUE # Check if we have a portfolio frontier ... weights <- getWeights(object@portfolio) if (is.null(dim(weights))) stop("The object is not a set of portfolios along the frontier.") # Use default color if not specified ... Title <- "Cov Risk Budgets" if (is.null(col)) col <- seqPalette(getNAssets(object), "Blues") if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX <- 0.9 else CEX <- 0.7 # Compute Covariance Risk Budgets: budgets <- getCovRiskBudgets(object@portfolio) pos.budgets <- +0.5 * (abs(budgets) + budgets) neg.budgets <- -0.5 * (abs(budgets) - budgets) # Define Plot Range: ymax <- max(rowSums(pos.budgets)) ymin <- min(rowSums(neg.budgets)) range <- ymax - ymin ymax <- ymax + 0.005 * range ymin <- ymin - 0.005 * range dim <- dim(budgets) range <- dim[1] xmin <- 0 xmax <- range + 0.2 * range # Create Bar Plots: if (labels) { if(!legend){ barplot(t(pos.budgets), space=0, ylab="", ylim=c(ymin, ymax), col=col, border="grey", ...) } else { legendtext <- names(getStatistics(object)$mu) if(is.null(legendtext)){ for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")} } barplot(t(pos.budgets), space=0, ylab="", xlim=c(xmin, xmax), ylim=c(ymin, ymax), col=col, border="grey", ...) legend("topright", legend = legendtext, bty = "n", cex=0.7, fill = col) } barplot(t(neg.budgets), space=0, add = TRUE, col=col, border="grey", ...) } else { barplot(t(pos.budgets), col=col, ...) } # Add Tailored Labels - 6 may be a good Number ... targetRisk = getTargetRisk(object@portfolio)[, 1] targetReturn = getTargetReturn(object@portfolio)[, 1] nSigma = length(targetRisk) nLabels <- 6 M = c(0, ( 1:(nSigma %/% nLabels) ) ) * nLabels + 1 # Take a reasonable number of significant digits to plot, e.g. 2 ... nSignifDigits = 3 axis(3, at = M, labels=signif(targetRisk[M], nSignifDigits)) axis(1, at = M, labels=signif(targetReturn[M], nSignifDigits)) # Add Axis Labels and Title: if(title) { mtext("Target Risk", side=3, line=2, adj=1, cex=CEX) mtext("Target Return", side=1, line=2, adj=1, cex=CEX) mtext("Cov Risk Budgets", side=2, line=2, adj=1, cex=CEX) } # Add Budgets 0 and 1 Reference Lines lines(x=c(0, nSigma), c(1, 1), col="grey", lty=3) lines(x=c(0, nSigma), c(0, 0), col="grey", lty=3) # Add vertical Line at minimum risk: minIndex = which.min(targetRisk) minRisk = signif(min(targetRisk), 3) abline(v = minIndex, col="black", lty = 1, lwd = 2) # Add Title: if (title) mtext(Title, adj=0, line=2.5, font=2, cex=CEX+0.1) # Complete to draw Box: if (box) box() # Add Rmetrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") # Return Value: invisible() } # ------------------------------------------------------------------------------ tailRiskBudgetsPlot <- function(object, labels=TRUE, col=NULL, title = TRUE, box = TRUE, legend = TRUE, ...) { # A function implemented by Diethelm Wuertz # Description: # Plots a bar chart of tail risk budgets # Arguments: # object - an object of class 'fPORTFOLIO' # labels - should the graph be automatically labeled? # col - a color palette, by default the rainbow palette # title - should the graph get default title and labels? # legend - should a legend be added to the plot? # FUNCTION: # Settings: mtext <- TRUE # Check if we have a portfolio frontier ... weights <- getWeights(object@portfolio) if (is.null(dim(weights))) stop("The object is not a set of portfolios along the frontier.") # Use default color if not specified ... Title <- "Tail Risk Budgets" if (is.null(col)) col <- seqPalette(getNAssets(object), "Blues") if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX <- 0.9 else CEX <- 0.7 # Check: stop("The tail risk budget plot is not yet implemented") tailRiskMatrix <- getTailRisk(object@portfolio) # Compute Tail Risk Budgets: budgets <- getTailRiskBudgets(object@portfolio) budgets[is.na(budgets)] <- 0 pos.budgets <- +0.5 * (abs(budgets) + budgets) neg.budgets <- -0.5 * (abs(budgets) - budgets) # Define Plot Range: ymax <- max(rowSums(pos.budgets)) ymin <- min(rowSums(neg.budgets)) range <- ymax - ymin ymax <- ymax + 0.005 * range ymin <- ymin - 0.005 * range dim <- dim(budgets) range <- dim[1] xmin <- 0 xmax <- range + 0.2 * range # Create Bar Plots: if(!legend){ barplot(t(pos.budgets), space=0, ylab="", ylim=c(ymin, ymax), col=col, border="grey", ...) } else { legendtext <- names(getStatistics(object)$mu) if(is.null(legendtext)){ for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")} } barplot(t(pos.budgets), space=0, ylab="", xlim=c(xmin, xmax), ylim=c(ymin, ymax), col=col, border="grey", ...) legend("topright", legend=legendtext, bty="n", cex=0.7, fill=col) } barplot(t(neg.budgets), space=0, add=TRUE, col=col, border="grey", ...) # Add Tailored Labels - 6 may be a good Number ... targetRisk <- getTargetRisk(object)[, 1] targetReturn <- getTargetReturn(object)[, 1] nSigma <- length(targetRisk) nLabels <- 6 M <- c(0, ( 1:(nSigma %/% nLabels) ) ) * nLabels + 1 nSignifDigits = 3 axis(3, at=M, labels=signif(targetRisk[M], nSignifDigits)) axis(1, at=M, labels=signif(targetReturn[M], nSignifDigits)) # Add Axis Labels and Title: if (title) { mtext("Target Risk", side=3, line=2, adj=1, cex=CEX) mtext("Target Return", side=1, line=2, adj=1, cex=CEX) mtext("Weight", side=2, line=2, adj=1, cex=CEX) } # Add Budgets 0 and 1 Reference Lines lines(x=c(0, nSigma), c(1, 1), col="grey", lty=3) lines(x=c(0, nSigma), c(0, 0), col="grey", lty=3) # Add vertical Line at minimum risk: minIndex <- which.min(targetRisk) minRisk <- signif(min(targetRisk), 3) abline(v = minIndex, col="black", lty = 1, lwd = 2) # Add Title: if (title) mtext(Title, adj=0, line=2.5, font=2, cex=CEX+0.1) # Complete to draw Box: if (box) box() # Add Rmetrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") # Return Value: invisible() } ################################################################################ riskBudgetsPlot <- function(object, FUN=c("budgetsNormalVAR","budgetsNormalES", "budgetsModifiedVAR","budgetsModifiedES", "budgetsSampleCOV"), labels=TRUE, col=NULL, title = TRUE, mtext = TRUE, box = TRUE, legend = TRUE, ...) { # A function implemented by Diethelm Wuertz # Modified by Venetia Christodoulopoulou 2013-01-22 # Description: # Plots a bar chart of tail risk budgets # Arguments: # object - an object of class 'fPORTFOLIO' # FUN - a character, the function name to compute the risk budgets, e.g. # "budgetsSampleCOV", "budgetsNormalVAR", "budgetsNormalES", # "budgetsModifiedVAR", "budgetsModifiedES" # labels - a logical, should the graph be automatically labeled? # col - a color palette, by default the rainbow palette # title - a logical, should the graph get default title and labels? # By default TRUE. # mtext - a logical, should the margin text be added? # box - a logical, should a box be xdrawn around the plot? # legend - a logical, should a legend be added to the plot? # ... - optional arguments passed to the barplot() function. # FUNCTION: # Extract Settings from the Potfolio Object: data <- getSeries(object@data) mu <- getMu(object) Sigma <- getSigma(object) weights <- getWeights(object@portfolio) alpha <- getAlpha(object@spec) # Plot Decoration: # name<-deparse(substitute(FUN)) FUN2<-match.arg(FUN) if(title)Title<-switch(FUN2,budgetsNormalVAR="Normal VAR Risk Budgets", budgetsNormalES="Normal ES Risk Budgets", budgetsModifiedVAR="Modified VAR Risk Budgets", budgetsModifiedES="Modified ES Risk Budgets", budgetsSampleCOV="Covariance Risk Budgets") else Title<-"" # empty string if (is.null(col)) col <- seqPalette(getNAssets(object), "Blues") if (sum(c(par()$mfrow, par()$mfcol)) == 4) cex=0.9 else cex=0.7 CEX<-0.7 # Compute Covariance Risk Budgets: FUN<-switch(FUN2,budgetsNormalVAR=budgetsNormalVAR, budgetsNormalES=budgetsNormalES, budgetsModifiedVAR=budgetsModifiedVAR, budgetsModifiedES=budgetsModifiedES) if(FUN2 == "budgetsSampleCOV") budgets <- getCovRiskBudgets(object@portfolio) else { fun <- function(x, data, alpha, mu, Sigma) FUN(data, weights=as.vector(x), alpha, mu, Sigma)$budgets budgets <- t(apply(weights, 1, fun, data=data, alpha=alpha, mu=mu, Sigma=Sigma)) } pos.budgets <- +0.5 * (abs(budgets) + budgets) neg.budgets <- -0.5 * (abs(budgets) - budgets) # Define Plot Range: ymax <- max(rowSums(pos.budgets)) ymin <- min(rowSums(neg.budgets)) range <- ymax - ymin ymax <- ymax + 0.005 * range ymin <- ymin - 0.005 * range dim <- dim(budgets) range <- dim[1] xmin <- 0 xmax <- range + 0.2 * range # Create Bar Plots: if (labels) { if(!legend){ barplot(t(pos.budgets), space=0, ylab="", ylim=c(ymin, ymax), col=col, border="grey") } else { legendtext <- names(getStatistics(object)$mu) if(is.null(legendtext)){ for(i in 1:dim[2]){legendtext[i] <- paste("Asset", i, sep = " ")} } barplot(t(pos.budgets), space=0, ylab="", xlim=c(xmin, xmax), ylim=c(ymin, ymax), col=col, border="grey") legend("topright", legend=legendtext, bty="n", cex=0.7, fill=col) } barplot(t(neg.budgets), space=0, add=TRUE, col=col, border="grey") } else { barplot(t(pos.budgets), col=col) } # Add Tailored Labels: nLabels <- 6 targetRisk <- getTargetRisk(object@portfolio)[, 1] targetReturn <- getTargetReturn(object@portfolio)[, 1] nSigma <- length(targetRisk) M <- c(0, ( 1:(nSigma %/% nLabels) ) ) * nLabels + 1 # Take a reasonable number of significant digits to plot: nSignifDigits <- 3 axis(3, at=M, labels=signif(targetRisk[M], nSignifDigits)) axis(1, at=M, labels=signif(targetReturn[M], nSignifDigits)) # Add Budgets 0 and 1 Reference Lines: lines(x=c(0, nSigma), c(1, 1), col="grey", lty=3) lines(x=c(0, nSigma), c(0, 0), col="grey", lty=3) # Add Vertical Line at Minimum Risk: minIndex <- which.min(targetRisk) minRisk <- signif(min(targetRisk), 3) abline(v=minIndex, col="black", lty=1, lwd=2) # Add Margin Text Info - Do not remove this line: mtext("Rmetrics", side=4, adj=0, col="grey", cex=CEX) # Add Title: if (title) mtext(Title, adj=0, line=2.5, font=2, cex=CEX+0.1) # Complete to draw Box: if (box) box() # Add Rmetrics - Do not Remove! mtext("Rmetrics", adj=0, side=4, cex=0.7, col="darkgrey") # Return Value: invisible(budgets) } ############################################################################### fPortfolio/R/object-getUseMethods.R0000644000175100001440000003112012421225024016752 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # getA Defines Use Method for A # getAlpha Defines Use Method for Alpha # getConstraints Defines Use Method for Constraints # getControl Defines Use Method for Control # getCov Defines Use Method for Cov # getCovRiskBudgets Defines Use Method for CovRiskBudgets # getData Defines Use Method for Data # getEstimator Defines Use Method for Estimator # getMean Defines Use Method for Mean # getMu Defines Use Method for Mu # getNAssets Defines Use Method for NAssets # .getNames Defines Use Method for Names # getNFrontierPoints Defines Use Method for NFrontierPoints # getMessages Defines Use Method for Messages # getObjective Defines Use Method for Objective # getOptim Defines Use Method for Optim # getOptimize Defines Use Method for Optimize # getOptions Defines Use Method for Options # getPortfolio Defines Use Method for Portfolio # getParams Defines Use Method for Params # getRiskFreeRates Defines Use Method for RiskFreeRates # getSeries Defines Use Method for Series # getSigma Defines Use Method for Sigma # getSolver Defines Use Method for Solver # getSpec Defines Use Method for Spec # getStatistics Defines Use Method for Statistics # getStatus Defines Use Method for Status # getTailRisk Defines Use Method for TailRisk # getTailRiskBudgets Defines Use Method for TailRiskBudgets # getTargetReturn Defines Use Method for TargetReturn # getTargetRisk Defines Use Method for TargetRisk # getTrace Defines Use Method for Trace # getType Defines Use Method for Type # getUnits Defines Use Method for Units [Asset Names] # getWeights Defines Use Method for Weights ################################################################################ getA <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getA") } # ------------------------------------------------------------------------------ getAlpha <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getAlpha") } # ------------------------------------------------------------------------------ getConstraints <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getConstraints") } # ------------------------------------------------------------------------------ getControl <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getControl") } # ------------------------------------------------------------------------------ getCov <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getCov") } # ------------------------------------------------------------------------------ getData <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getData") } # ------------------------------------------------------------------------------ getCovRiskBudgets <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getCovRiskBudgets") } # ------------------------------------------------------------------------------ getEstimator <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getEstimator") } # ------------------------------------------------------------------------------ getMean <- function(object) { # A function implemented by Diethelm Wuertz # Return Value: UseMethod("getMean") } # ------------------------------------------------------------------------------ getMu <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getMu") } # ------------------------------------------------------------------------------ getNAssets <- function(object) { # A function implemented by Diethelm Wuertz # Return Value: UseMethod("getNAssets") } # ------------------------------------------------------------------------------ .getNames <- function(object) { # A function implemented by Diethelm Wuertz # REPLACED BY getUnits. # Return Value: UseMethod("getNames") } # ------------------------------------------------------------------------------ getNFrontierPoints <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getNFrontierPoints") } # ------------------------------------------------------------------------------ getMessages <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getMessages") } # ------------------------------------------------------------------------------ getObjective <- function(object) { # A function implemented by Diethelm Wuertz UseMethod("getObjective") } # ------------------------------------------------------------------------------ getOptim <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getOptim") } # ------------------------------------------------------------------------------ getOptimize <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: UseMethod("getOptimize") } # ------------------------------------------------------------------------------ getOptions <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getOptions") } # ------------------------------------------------------------------------------ getPortfolio <- function(object) { # A function implemented by Diethelm Wuertz # Return Value: UseMethod("getPortfolio") } # ------------------------------------------------------------------------------ getParams <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: UseMethod("getParams") } # ------------------------------------------------------------------------------ getRiskFreeRate <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getRiskFreeRate") } # ------------------------------------------------------------------------------ # DW: Take care of getSeries in package timeSeries getSeries <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getSeries") } # ------------------------------------------------------------------------------ getSigma <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getSigma") } # ------------------------------------------------------------------------------ getSolver <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getSolver") } # ------------------------------------------------------------------------------ getSpec <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getSpec") } # ------------------------------------------------------------------------------ getStatistics <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getStatistics") } # ------------------------------------------------------------------------------ getStatus <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getStatus") } # ------------------------------------------------------------------------------ getTailRisk <- function(object) { # A function implemented by Diethelm Wuertz # Return Value: UseMethod("getTailRisk") } # ------------------------------------------------------------------------------ getTailRiskBudgets <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getTailRiskBudgets") } # ------------------------------------------------------------------------------ getTargetReturn <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getTargetReturn") } # ------------------------------------------------------------------------------ getTargetRisk <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getTargetRisk") } # ------------------------------------------------------------------------------ getTrace <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getTrace") } # ------------------------------------------------------------------------------ getType <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getType") } # ------------------------------------------------------------------------------ # DW: already defined in package timeSeries # getUnits <- # function(object) # { # # A function implemented by Diethelm Wuertz # # # FUNCTION: # # # Return Value: # UseMethod("getUnits") # } # ------------------------------------------------------------------------------ # TS: already defined in package fBasics # getModel <- # function(object) # { # # A function implemented by Tobias Setz # # # FUNCTION: # # # Return Value: # UseMethod("getModel") # } # ------------------------------------------------------------------------------ getWeights <- function(object) { # A function implemented by Diethelm Wuertz # FUNCTION: # Return Value: UseMethod("getWeights") } ################################################################################ fPortfolio/R/mathprogQP-ampl.R0000644000175100001440000001313612323217770015760 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # ramplQP Rmetrics Interface for AMPL QP solvers # amplQP Convenience wrapper for AMPL QP solvers # amplQPControl AMPL QP control parameter list ############################################################################### ramplQP <- function(objective, lower=0, upper=1, linCons, control=list()) { # A function implemented by Diethelm Wuertz # Description: # Rmetrics Interface for AMPL QP solvers # Arguments: # objective - list(dvec=NULL, Dmat = NULL) # FUNCTION: # Control List: ctrl <- amplQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Controls: project <- control$project solver <- control$solver inf <- control$inf trace <- control$trace # General Settings: dvec <- objective$dvec Dmat <- objective$Dmat obj <- rbind(dvec, Dmat) # Box Constraints: replicate <- function(x, n) if(length(x) == 1) rep(x, n) else x n <- ncol(obj) x_L <- replicate(lower, n) x_U <- replicate(upper, n) x_L[is.infinite(x_L)] <- inf*sign(x_L[is.infinite(x_L)]) x_U[is.infinite(x_U)] <- inf*sign(x_U[is.infinite(x_U)]) # Linear Constraints: A <- linCons[[1]] m <- nrow(A) b_L <- replicate(linCons[[2]], m) b_U <- replicate(linCons[[3]], m) b_L[is.infinite(b_L)] <- inf*sign(b_L[is.infinite(b_L)]) b_U[is.infinite(b_U)] <- inf*sign(b_U[is.infinite(b_U)]) # Optimize Portfolio: value <- amplQP(objective, x_L, x_U, A, b_L, b_U, control) # Return Value: value } ############################################################################### amplQP <- function( objective=list(dvec=NULL, Dmat=NULL), x_L=NULL, x_U=NULL, A=NULL, b_L=NULL, b_U=NULL, control=list(), ...) { # A function implemented by Diethelm Wuertz # Description: # Convenience wrapper for AMPL QP solvers # Arguments: # objective - list(dvec=NULL, Dmat = NULL) # FUNCTION: # Control List: ctrl <- amplQPControl() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control <- ctrl # Control Parameters: project <- control$project solver <- control$solver inf <- control$inf trace <- control$trace # Solver Settings: c <- objective$dvec F <- objective$Dmat obj <- rbind(c, F) n <- ncol(obj) m <- nrow(A) # Assign QP Model: .qpAssign(project, c, F, x_L, x_U, A, b_L, b_U , trace=FALSE) # Run AMPL: command <- paste("ampl -t -vs", paste(project, "run", sep=".")) solve <- system(command, intern=TRUE) # Read AMPL Output File: file <- paste(project, "txt", sep = ".") out <- scan(file, what=character(0), sep="\n", quiet=TRUE) # Get Weights: Index <- (grep(";", out) - 1)[1] splits <- strsplit(paste(out[2:Index], collapse=" "), " ")[[1]] solution <- as.numeric(splits[splits != ""])[seq(2, 2*n, by=2)] Index <- as.numeric(splits[splits != ""])[seq(1, 2*n, by=2)] solution[Index] <- solution # Get Status: status <- strsplit(out[grep("solve_result", out)], split=" ") statusCode <- status[[1]][3] statusMessage <- status[[2]][3] # Get Solver Message: Index <- grep("solve_message", out):length(out) message <- out[Index] # Version: version <- system(paste(solver, "-v"), intern=TRUE) # Compose Results into a List: objective <- (c %*% solution + 0.5 * solution %*% F %*% solution)[[1, 1]] # Return Value: model <- capture.output(amplModelShow(project)) run <- capture.output(amplRunShow(project)) value <- list( opt = list(solve=solve, model=model, run=run, out=out), solution = solution, objective = objective, status = statusCode, message = statusMessage, solver = paste("AMPL", solver), version = version) class(value) <- c("solver", "list") value } # ----------------------------------------------------------------------------- amplQPControl <- function(solver="ipopt", project="ampl", inf=1e12, trace=FALSE) { # A function implemented by Diethelm Wuertz # Description: # Returns AMPL QP control parameter list # FUNCTION: # Control Parameter: control <- list(solver=solver, project=project, inf=inf, trace=trace) # Return Value: control } ############################################################################### fPortfolio/R/methods-show.R0000644000175100001440000002534712620132672015374 0ustar hornikusers ################################################################################ # FUNCTION: DESCRIPTION: # show.fPORTFOLIO S4 Print method for 'fPPORTFOLIO' objects # show.fPFOLIODATA S4 Print method for 'fPFOLIODATA' objects # show.fPFOLIOSPEC S4 Print method for 'fPFOLIOSPEC' objects # show.fPFOLIOCON S4 Print method for 'fPFOLIOCON' objects ################################################################################ setMethod("show", "fPORTFOLIO", function(object) { # A function implemented by Diethelm Wuertz and Yohan Chalabi # Description: # S4 Print Method for an object of class "fPORTFOLIO" # Arguments: # object - an object of class "fPORTFOLIO" # FUNCTION: # Determine Length Out: nFrontierPoints <- NROW(matrix(getWeights(object@portfolio), ncol = getNAssets(object))) length.out <- getRmetricsOptions("length.print") # from Rmetrics Options index <- if (length.out) { unique(trunc(seq.int(from = 1, to = nFrontierPoints, length.out = length.out))) } else { seq.int(from = 1, to = NROW(nFrontierPoints)) } # Print Title: cat("\nTitle:\n ") # cat(getType(object), getTitle(object), "\n") cat(getType(object), object@title, "\n") cat(" Estimator: ", getEstimator(object), "\n") cat(" Solver: ", getSolver(object), "\n") cat(" Optimize: ", getOptimize(object), "\n") cat(" Constraints: ", getConstraintsTypes(object), "\n") if (object@spec@ampl$ampl) { cat(" AMPL Project: ", object@spec@ampl$project, "\n") cat(" AMPL Solver: ", object@spec@ampl$solver, "\n") } if (!identical(index, 1)) cat(" Portfolio Points: ", length(index), "of", nFrontierPoints, "\n") if (getType(object) == "CVaR") cat(" VaR Alpha: ", getAlpha(object), "\n") #at(" Objective: ", getObjective(object), "\n") # Assets: nAssets <- getNAssets(object) Names <- names(object@data@statistics$mu) # Print Target Weights: cat("\nPortfolio Weights:\n") table <- matrix(round(getWeights(object@portfolio), digits = 4), ncol = nAssets) colnames(table) = Names rownames(table) = 1:NROW(table) print.table(table[index, ]) # Print Covariance Risk Budgets: cat("\nCovariance Risk Budgets:\n") table = matrix(round(getCovRiskBudgets(object@portfolio), digits = 4), ncol = nAssets) colnames(table) = Names rownames(table) = 1:NROW(table) print.table(table[index, ]) # PrintCVaR Risk Budgets: # to do ... # Print Tail Risk Budgets: # to do ... # Print Target Return and Risks: # DW: Note object@targetR* is a list do not use getTargetR*() targetReturn <- matrix(getTargetReturn(object@portfolio), ncol = 2) targetRisk <- matrix(getTargetRisk(object@portfolio), ncol = 4) target <- round(cbind(targetReturn, targetRisk), digits = 4) if (class(getSeries(object)) == "logical") { cat("\nTarget Return and Risk:\n") target = target[, c(1, 3), drop = FALSE] colnames(target) = c("mean", "Cov") } else if( class(getSeries(object)) == "timeSeries") { cat("\nTarget Returns and Risks:\n") colnames(target) = c("mean", "mu", "Cov", "Sigma", "CVaR", "VaR") } rownames(target) = 1:NROW(target) # DW Only print mu and Sigma for robust estimators! if (getEstimator(object) == "covEstimator") { print.table(target[index, -c(2,4)]) } else { print.table(target[index, ]) } # Print Description: cat("\nDescription:\n ") # cat(getDescription(object), "\n") cat(object@description, "\n") # Return Value: invisible(NULL) }) # ------------------------------------------------------------------------------ setMethod("show", "fPFOLIODATA", function(object) { # A function implemented by Diethelm Wuertz and Yohan Chalabi # Description: # S4 Print Method for an object of class "fPFOLIODATA" # Arguments: # object - an object of class "fPFOLIOSPEC" # FUNCTION: # Series: cat("\nHead/Tail Series Data:\n") if(is.null(dim(object@data$series))) { cat(" No time series data available.\n") } else { cat("\n") print(head(object@data$series, n = 3)) print(tail(object@data$series, n = 3)) } # Statistics: cat("\nStatistics:\n\n") if(is.null(dim(object@data$series))) { # Print mean and Cov only .. print(object@statistics[1:2]) } else { # Print mean, Cov, estimator, mu and Sigma ... print(object@statistics) } # Tailrisk: # NYI # Return Value: invisible(NULL) }) # ------------------------------------------------------------------------------ setMethod("show", "fPFOLIOSPEC", function(object) { # A function implemented by Diethelm Wuertz and Yohan Chalabi # Description: # S4 Print Method for an object of class "fPFOLIOSPEC" # Arguments: # object - an object of class "fPFOLIOSPEC" # FUNCTION: # Model: cat("\nModel List:\t") cat("\n Type: ", object@model$type) cat("\n Optimize: ", object@model$optimize) cat("\n Estimator: ", object@model$estimator) if (length(object@model$tailRisk) > 0) { cat("\n Tail Risk: ", object@model$tailRisk) } # DW: # } else { # cat("\n Tail Risk: ", "list()") # } cat("\n Params: ", paste(names(unlist(object@model$params)), "=", unlist(object@model$params))) # Portfolio: cat("\n\nPortfolio List:\t") if (!is.null(object@portfolio$weights)) { cat("\n Portfolio Weights: ", object@portfolio$weights) } else { cat("\n Target Weights: ", "NULL") } if (!is.null(object@portfolio$targetReturn)) { cat("\n Target Return: ", object@portfolio$targetReturn) } else { cat("\n Target Return: ", "NULL") } if (!is.null(object@portfolio$targetRisk)) { cat("\n Target Risk: ", object@portfolio$targetRisk) } else { cat("\n Target Risk: ", "NULL") } if (!is.null(object@portfolio$riskFreeRate)) { cat("\n Risk-Free Rate: ", as.character(object@portfolio$riskFreeRate)) } if (!is.null(object@portfolio$nFrontierPoints)) { cat("\n Number of Frontier Points:", as.character(object@portfolio$nFrontierPoints)) } if (!is.na(object@portfolio$status)) { cat("\n Status: ", as.character(object@portfolio$status)) } # Optimization: cat("\n\nOptim List:\t") cat("\n Solver: ", object@optim$solver) if (!is.null(object@optim$objective)) { cat("\n Objective: ", as.character(object@optim$objective)) } else { cat("\n Objective: ", "list()" ) } if (substr(object@optim$solver, 1, 14) != "solveRquadprog") object@optim$options$meq <- NULL if (length(object@optim$options) > 0) { cat("\n Options: ", paste(names(unlist(object@optim$options)), "=", unlist(object@optim$options))) } if (length(object@optim$control) > 0) { cat("\n Control: ", as.character(object@optim$control)) } # DW # } else { # cat("\n Control: ", "list()") # } cat("\n Trace: ", object@optim$trace) # Messages: if (object@messages$messages) { cat("\n\nMessage List:\t") if (!is.null(object@messages$list)) { cat("\n List: ", object@messages$list) } else { cat("\n List: ", "NULL") } } # AMPL: if (object@ampl$ampl) { cat("\n\nAMPL List:\t") cat("\n Project: ", object@ampl$project) cat("\n Solver: ", object@ampl$solver) cat("\n Trace: ", object@ampl$trace) } cat("\n") # Return Value: invisible(NULL) }) # ------------------------------------------------------------------------------ setMethod("show", "fPFOLIOCON", function(object) { # A function implemented by Diethelm Wuertz and Yohan Chalabi # Description: # S4 Print Method for an object of class "fPFOLIODATA" # Arguments: # object - an object of class "fPFOLIOSPEC" # FUNCTION: # Print Title: cat("\nTitle:\n ") cat("Portfolio Constraints\n") minmaxW = rbind(object@minWConstraints, object@maxWConstraints) rownames(minmaxW) = c("Lower", "Upper") if (length(minmaxW)) { cat("\nLower/Upper Bounds:\n") print(minmaxW) } eqsumW = object@eqsumWConstraints if (sum(dim(eqsumW)) > 2) { cat("\nEqual Matrix Constraints:\n") print(eqsumW) } minsumW = object@minsumWConstraints if (sum(dim(minsumW)) > 2) { cat("\nLower Matrix Constraints:\n") print(minsumW) } maxsumW = object@maxsumWConstraints if (sum(dim(maxsumW)) > 2) { cat("\nUpper Matrix Constraints:\n") print(maxsumW) } minmaxB <- rbind(object@minBConstraints, object@maxBConstraints) if (length(minmaxB) > 0 && !(all(object@minBConstraints == -Inf) && all(object@maxBConstraints == 1))) { cat("\nLower/Upper Cov Risk Budget Bounds:\n") rownames(minmaxB) = c("Lower", "Upper") print(minmaxB) } listF = object@listFConstraints minF = object@minFConstraints maxF = object@maxFConstraints if (length(listF) > 0) { cat("\nNon-Linear Function Constraints:\n") minmaxF = rbind(minF, maxF) colnames(minmaxF) = names(listF) rownames(minmaxF) = c("Lower", "Upper") print(minmaxF) } nCard = object@nCardConstraints if(nCard > 0) { minCard = object@minCardConstraints maxCard = object@maxCardConstraints minmaxCard = rbind(minCard, maxCard) #colnames(minmaxCard) = names(listF) rownames(minmaxCard) = c("Lower", "Upper") cat("\nCardinality Constraints:\n") print(minmaxCard) } # Return Value: invisible(NULL) }) ################################################################################ fPortfolio/R/monitor-indicators.R0000644000175100001440000001737512323217770016604 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ############################################################################### # FUNCTION: DESCRIPTION: # .emaIndicator Exponential moving average indicator # .macdIndicator MACD Indicator # .drawdownsIndicator Maximum drawdowns Indicator # FUNCTION: DESCRIPTION: # .rebalancingStats Rebalancing statistics ############################################################################### .emaIndicator <- function(series, lambda) { # A function implemented by Diethelm Wuertz # Description: # Exponential moving average indicator # FUNCTION: # EMA: x <- rep(mean(series[1:10,]), times=nrow(series)) for (i in 2:nrow(series)) x[i] <- (1-lambda)*series[i] + lambda*x[i-1] x <- as.timeSeries(data=x, charvec=time(series), units=colnames(series)) # Return Value: x } # ----------------------------------------------------------------------------- .macdIndicator <- function(index, spar=0.5, lambda=c(0.80, 0.85, 0.90), trace = TRUE, doplot=TRUE) { # A function implemented by Diethelm Wuertz # Description: # MACD price/index indicator # FUNCTION: # Series: rets <- returns(index) Index <- log(index)[-1, ] # Turning Points: tps <- turnsAnalytics(index=index, spar=spar, main = "MACD Analytics", trace=TRUE, doplot=FALSE) ablines <- tps$ablines # MACD Analytics: ema1 <- .emaIndicator(Index, lambda=lambda[1]) ema2 <- .emaIndicator(Index, lambda=lambda[2]) macd <- ema1 - ema2 signal <- .emaIndicator(macd, lambda[3]) histogram <- macd - signal # Indicator: indicator <- sign(histogram) rebalancing <- .rebalancingStats(index, indicator, trace=trace) # Plot Turning Points: if(doplot) { turnsAnalytics(index=index, spar=spar, main="MACD Index Indicator", trace=FALSE, doplot=doplot) tradePositions <- as.vector(indicator) tradeForecasts <- c(0, tradePositions[-length(tradePositions)]) outSample <- Index[1] + log(cumulated(rets*tradeForecasts)) Ups <- Index[as.vector(indicator) == 1, ] if(nrow(Ups) > 0) points(Ups, pch=19, cex=0.33, col="green") Downs <- Index[as.vector(indicator) == 0, ] if(nrow(Downs) > 0) points(Downs, pch=19, cex=0.33, col="blue") lines(outSample, col="magenta") box(col="white") box(bty="l") } # Plot Indicator: if(doplot) { plot(macd, col="green", ylab=paste("MACD", colnames(index))) abline(v=ablines, lty=3, lwd=2, col="grey") lines(histogram, type="h", col="black") lines(macd, col="red") mtext(paste("lambda: ", lambda[1], lambda[2], lambda[2], sep=" "), adj=0, side=4, cex=0.7, col="darkgrey") box(col="white") box(bty="l") } # Return Value: invisible(list(index=index, macd=macd, histogram=histogram, rebalancing=rebalancing)) } # ----------------------------------------------------------------------------- .drawdownsIndicator <- function(index, spar=0.5, lambda=c(0.80, 0.85, 0.10), trace=TRUE, doplot=TRUE) { # A function implemented by Diethelm Wuertz # Description: # Drawdown analytics # Arguments: # index - an index or price S4 'timeSeries' object # FUNCTION: # Series: rets <- returns(index) Index <- log(index)[-1, ] # Turning Points: tps <- turnsAnalytics(index=index, spar=spar, main = "MACD Drawdown Analytics", trace=TRUE, doplot=FALSE) ablines <- tps$ablines # Returns and Drawdowns: dd <- drawdowns(rets) # Long/Short Drawdowns EMA: mdd1 <- .emaIndicator(dd, lambda[1]) mdd2 <- .emaIndicator(dd, lambda[2]) # MACD/Signal/Histogram Line: macd <- mdd1 - mdd2 signal <- .emaIndicator(macd, lambda[3]) histogram <- macd - signal # Indicator: indicator <- rets series(indicator) <- 1-sign(as.integer(macd < 0 & histogram < 0 )) rebalancing <- .rebalancingStats(index, indicator, trace=trace) # Plot Turning Points: if(doplot) { tps <- turnsAnalytics(index=index, spar=spar, main="MACD Drawdown Indicator", trace=FALSE, doplot=doplot) tradePositions <- as.vector(indicator) tradeForecasts <- c(0, tradePositions[-length(tradePositions)]) outSample <- Index[1] + log(cumulated(rets*tradeForecasts)) Ups <- Index[as.vector(indicator) == 1,] if(nrow(Ups) > 0) points(Ups, pch=19, cex=0.33, col="green") Downs <- Index[as.vector(indicator) == 0, ] if(nrow(Downs) > 0) points(Downs, pch=19, cex=0.33, col="blue") lines(outSample, col="magenta") box(col="white") box(bty="l") } # Plot Indicator: if(doplot) { plot(mdd1, ylim=c(min(dd), max(macd)), ylab=colnames(index)) positions <- tps$positions ablines <- tps$ablines abline(v=ablines, lty=1, lwd=2, col="lightgrey") Time <- time(indicator) Time <- Time[!as.logical(indicator)] abline(v=Time, lty=3, lwd=2, col="steelblue") lines(mdd1, col="black") lines(mdd2, col="red") lines(max(abs(macd))*histogram/max(abs(histogram)), type="h", col="orange") lines(max(abs(macd))*histogram/max(abs(histogram)), type="l", col="orange") abline(h=0, col="grey") mtext(paste("lambda: ", lambda[1], lambda[2], lambda[2], sep=" "), adj=0, side=4, cex=0.7, col="darkgrey") box(col="white") box(bty="l") } # Return Value: invisible(list(indicator=indicator, index=index, returns=rets, drawdowns=dd, macd=macd, signal=signal, histogram=histogram, rebalancing=rebalancing)) } ############################################################################### .rebalancingStats <- function(index, indicator, trace=TRUE) { # A function implemented by Diethelm Wuertz # Description: # Simple rebalancing statistics # Arguments: # index - an index or price S4 'timeSeries' object # FUNCTION: # Returns: rets <- returns(index) # Rebalancing: tradePositions <- as.vector(indicator) tradeForecasts <- c(0, tradePositions[-length(tradePositions)]) rebalancing <- c( max=sum(abs(rets)), insample=sum(rets*tradePositions), forecasts=sum(rets*tradeForecasts), rets=sum(rets)) # Trace: if (trace) { cat("Rebalancing:\n") print(rebalancing) } # Return Value: invisible(rebalancing) } ############################################################################### fPortfolio/R/methods-mathprog.R0000644000175100001440000000203512323217770016225 0ustar hornikusers ################################################################################ # FUNCTION: DESCRIPTION: # print.solver S3 Print method for solver objects ################################################################################ print.solver <- function(x, ...) { # A function implemented by Diethelm Wuertz # Description: # S3 Print method for solver objects # Arguments: # x - a list as returned by solver functions # FUNCTION: cat("\nMathematical Programming:\n ") cat(x$version, sep="\n") cat("\n") cat(" Objective: ", x$objective, "\n") cat(" Solution: ", head(x$solution), "...\n") cat(" Status Code: ", x$status, "\n") cat(" Message: ", x$message, "\n") cat(" Solver: ", x$solver, "\n") #cat(" Version: ", x$version, "\n") # Return Value: invisible(x) } ################################################################################ fPortfolio/R/backtest-getMethods.R0000644000175100001440000001537512323217770016657 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # getWindows Extracts windows information # getWindowsFun Extracts windows function # getWindowsParams Extracts windows function parameters # getWindowsHorizon Extracts windows Horizon # FUNCTION: DESCRIPTION: # getStrategy Extracts strategy information # getStrategyFun Extracts strategy function # getStrategyParams Extracts strategy function parameters # FUNCTION: DESCRIPTION: # getSmoother Extracts smoother information # getSmootherFun Extracts smoother function # getSmootherParams Extracts smoother function parameters # getSmootherLambda Extracts decay parameter # getSmootherDoubleSmoothing Extracts double smoothing flag # getSmootherInitialWeights Extracts initial weights # getSmootherSkip Extracs skip smoothing flag # FUNCTION: DESCRIPTION: # getMessages Extracts messages ################################################################################ getWindows <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getWindows") } # ------------------------------------------------------------------------------ getWindowsFun <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getWindowsFun") } # ------------------------------------------------------------------------------ getWindowsParams <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getWindowsParams") } # ------------------------------------------------------------------------------ getWindowsHorizon <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getWindowsHorizon") } # ------------------------------------------------------------------------------ getSmoother <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getSmoother") } # ------------------------------------------------------------------------------ getSmootherFun <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getSmootherFun") } # ------------------------------------------------------------------------------ getSmootherParams <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getSmootherParams") } # ------------------------------------------------------------------------------ getSmootherLambda <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getSmootherLambda") } # ------------------------------------------------------------------------------ getSmootherDoubleSmoothing <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getSmootherDoubleSmoothing") } # ------------------------------------------------------------------------------ getSmootherInitialWeights <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getSmootherInitialWeights") } # ------------------------------------------------------------------------------ getSmootherSkip <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getSmootherSkip") } # ------------------------------------------------------------------------------ getStrategy <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getStrategy") } # ------------------------------------------------------------------------------ getStrategyFun <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: UseMethod("getStrategyFun") } # ------------------------------------------------------------------------------ getStrategyParams <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getStrategyParams") } # ------------------------------------------------------------------------------ if(FALSE) { # Already defined in fPortfolio getMessages <- function(object) { # A function implemented by Diethelm Wuertz and William Chen # Description: # Arguments: # FUNCTION: # Return Value: UseMethod("getMessages") } } ################################################################################ fPortfolio/R/solve-RquadprogCLA.R0000644000175100001440000001266112410247202016351 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # solveRquadprog.CLA Portfolio interface to solver Rquadprog # .claRquadprogArguments Returns arguments for solver # FUNCTION: DESCRIPTION: # .quadprog.CLA Wrapper to solver function ################################################################################ solveRquadprog.CLA <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Portfolio interface to solver Rquadprog # Example: # solveRquadprogCLA(data, spec, constraints)[-3] # FUNCTION: # Update Specification: setTargetReturn(spec) <- NA # Transform Data: Data <- portfolioData(data, spec) nAssets <- getNAssets(Data) # Compile Arguments for Solver: args <- .claRquadprogArguments(data, spec, constraints) # Solve Multiassets Portfolio: ans <- .quadprog.CLA( Dmat = args$Dmat, dvec = args$dvec, Amat = args$Amat, bvec = args$bvec, meq = args$meq, lambda = args$lambda) # Save Arguments: ans$optim$args <- args class(ans) <- c("solver", "list") # Return Value: ans } ################################################################################ .claRquadprogArguments <- function(data, spec, constraints) { # A function implemented by Diethelm Wuertz # Description: # Returns quadprog conform arguments for the solver # FUNCTION: # Set up the default quadprog QP ans <- .rquadprogArguments(data, spec, constraints) # Optimize: # min(-d^T x + 1/2 x^T D x) # Start from it and modify for CLA: lambda <- spec@model$param$lambda ans$Dmat <- lambda * getSigma(portfolioData(data)) / 2 ans$dvec <- getMu(portfolioData(data)) ans$Amat <- ans$Amat[, -1] ans$bvec <- ans$bvec[-1] ans$meq <- ans$meq - 1 ans$dir <- ans$dir[-1] ans$lambda <- lambda # Return Value: ans } ################################################################################ .quadprog.CLA <- function(Dmat, dvec, Amat, bvec, meq, lambda) { # A function implemented by Diethelm Wuertz # Description: # Goldfarb and Idnani's quadprog solver function # Note: # Requires to load contributed R package quadprog from which we use # the Fortran subroutine of the quadratic solver. # Package: quadprog # Title: Functions to solve Quadratic Programming Problems. # Author: S original by Berwin A. Turlach # R port by Andreas Weingessel # Maintainer: Andreas Weingessel # Description: This package contains routines and documentation for # solving quadratic programming problems. # License: GPL-2 # Value of slove.QP(): # solution - vector containing the solution of the quadratic # programming problem. # value - scalar, the value of the quadratic function at the # solution # unconstrained.solution - vector containing the unconstrained # minimizer of the quadratic function. # iterations - vector of length 2, the first component contains # the number of iterations the algorithm needed, the second # indicates how often constraints became inactive after # becoming active first. vector with the indices of the # active constraints at the solution. # FUNCION: # Optimize: optim <- quadprog::solve.QP( Dmat = Dmat, dvec = dvec, Amat = Amat, bvec = bvec, meq = meq, factorized = FALSE) # Set Tiny Weights to Zero: weights <- .checkWeights(optim$solution) attr(weights, "invest") <- sum(weights) # Compose Output List: Sigma <- Dmat * 2 / lambda mu <- dvec ans <- list( type = "MV", solver = "solveRquadprog.CLA", optim = optim, weights = weights, solution = weights, targetReturn = (optim$solution %*% mu)[[1,1]], targetRisk = sqrt(optim$solution %*% Sigma %*% optim$solution)[[1,1]], objective = optim$crval, # To do: Add status information status = 0, message = "minRisk") # Return Value: ans } ################################################################################ fPortfolio/MD50000644000175100001440000002223713630700055012730 0ustar hornikusers84e94ae8a4e32c30936996f9f0cef576 *ChangeLog 18f61d8cd0efcc19049da0605b3c64c8 *DESCRIPTION c045c3292c2769af9e17c8535cf01b40 *NAMESPACE 9c61ea20343e8315109a8c6047bb8866 *R/00RmetricsPortfolio-package.R 6861674434ab48aaa7269a75d6f6c912 *R/a-class-fPFOLIOBACKTEST.R 80a747f51860402e2e5588831c5bf406 *R/a-class-fPFOLIOCON.R 1fe90749dd54ea433cf28e8d05ee9ecb *R/a-class-fPFOLIODATA.R 217e08a8e3c1d786cf184678180addb7 *R/a-class-fPFOLIOSPEC.R f51bcd4a59433c22181b285425dd6b49 *R/a-class-fPFOLIOVAL.R 26600b6f229cae5def77e8f37d9ec2a7 *R/a-class-fPORTFOLIO.R 86e28e1a826e7ff5596ec3eb88c08d91 *R/backtest-Plots.R fafdb0e0647ba7670f83ac721dd882fc *R/backtest-defaultFunctions.R 2995cdae6303b6c967fab0901fffc78a *R/backtest-getBacktestSpec.R 7b362fa49fe5147cd8a8b508dacddbf8 *R/backtest-getMethods.R 26f480ff3d38f6471400e70958a90c9d *R/backtest-methodsShow.R 31eb51e1db80e42c539c6926620176d1 *R/backtest-netPerformance.R efb22c517f58a7c035742c38d9a36940 *R/backtest-pfolioBacktestSpec.R 5b49c2f6e2e37558c00a6e5e86e28b31 *R/backtest-pfolioBacktesting.R 929abaa9286261495c2f5cfe2f93fc2f *R/backtest-rollingStats.R 8eca1ef71a54b00d563a56635e6d8b84 *R/backtest-setBacktestSpec.R bebbba59f7fb1ea0b015aa86731eeb39 *R/frontier-getPoints.R ab51aaffa694f4f61d53b0cf020b5da8 *R/frontier-portfolioPlots.R 0c204869c95341a86a2f9a634c3a05bb *R/frontier-weightPlots.R 12da752939eaf2aad6c4025c97e12f18 *R/mathprogLP-ampl.R 02bcd48cafdc16bfea96dfbccbdf0195 *R/mathprogLP-glpk.R cdf8bf7e85786ae2a36cbdae098753c5 *R/mathprogLP-neos.R 1b8e3d0145709b556260d19c11a291c5 *R/mathprogLP-symphony.R fdd5a777f1e76fdee002a8d4aa020493 *R/mathprogLP.R 4428e534ff8c53da0fba84bb22f4213f *R/mathprogNLP-ampl.R be7f8d410b2967e5080069e89b2b3343 *R/mathprogNLP-donlp2.R 22461097a1bbf8860ff9e001307830ce *R/mathprogNLP-nlminb2.R 163951e5af04a0f23a8d5296bfdf69bb *R/mathprogNLP-solnp.R 8e8b410b008799f7cca382c874b69ac0 *R/mathprogNLP.R bd42c6082a0f05a2beb1958bfab836ba *R/mathprogQP-ampl.R 1e3471c95a8bb7c5949de1469b52ad3e *R/mathprogQP-ipop.R d353b2e6375377e596b31dfe61b23104 *R/mathprogQP-kestrel.R 5e14b69fced80eaecc086c53e01ca8ef *R/mathprogQP-neos.R 0257d6a35b52cc4bc9b6b0399c75fe66 *R/mathprogQP-quadprog.R 9177cb5c5f4a5d5e06482d465f3b5677 *R/mathprogQP.R 8c559056911428893b70d9d12b07089b *R/methods-mathprog.R 8368a5d4d5e77b328c842bb36fdbaba3 *R/methods-plot.R f729fe56a411603a3f3a2714e8383d56 *R/methods-show.R 749a323db19bfe4cae10fc1727d06f1a *R/methods-summary.R de25c1eaa2f5f9b0e3bbc30f90d314be *R/monitor-indicators.R e8ed773f017fe1f4602726d72358c85d *R/monitor-stability.R b674387d5606178afb6623527d0c87b3 *R/object-getData.R 2752da6015144a4701a51c8a91ad4aa2 *R/object-getPortfolio.R ba4b9d8a140e4ffdafe6653528833c4d *R/object-getPortfolioVal.R cf5fa493a8521ecfcf2a736c076bebad *R/object-getSpec.R 80d1e9dd9cb59786a803cc0284b5b7ad *R/object-getUseMethods.R 3f06ddd58d065b784b7e3ee38967cc55 *R/object-portfolioConstraints.R e07080e8276aed3a72121cec4f9a07af *R/object-portfolioData.R 0e6af119d9a9bda8c0302be6c4cddcb6 *R/object-portfolioSpec.R 4c8694c99a3c7a9f0348c2a9fb2a241d *R/object-setSpec.R b3c00ece0c3bea0e950c563fa15eaea2 *R/plot-vaniniFig.R 2816d5409df473091a3126c24ca55145 *R/plot-weightsLines.R 8a7362f95d75d86de9251f99f42250ad *R/plot-weightsPies.R d37a7325b0123ad253d4d6881f071559 *R/plot-weightsPlots.R c83b26cd69b6adde4f23d2da34047887 *R/plot-weightsSlider.R 4ca48732f888a29777f356a5ecc8256b *R/portfolio-efficientFrontier.R 760d0e43bc1ea0e0e3754069d1926780 *R/portfolio-efficientPfolio.R bd2ad7d2136f7da491ae64e2cdbda3d5 *R/portfolio-feasiblePfolio.R 4ca83d7b214c3826ff6b4c09dcdbd852 *R/portfolio-riskPfolio.R 46a83e737d99e7e5bd84af5ce7c08192 *R/portfolio-rollingPfolio.R 3ab6aa74ee174cbe753eb858410232a9 *R/risk-budgeting.R 63dc17c6e14016c69a206babbd7d3869 *R/risk-covEstimator.R 381f99e393a11577ccbe7d279486143c *R/risk-pfolioMeasures.R b53df020921f9816a5f0de25c2c68f18 *R/risk-surfaceRisk.R 1f66b7bae522ee57658524c5449224d8 *R/risk-tailBudgets.R 9c39859563c928ef4ac367130d52d8fe *R/risk-ternaryMap.R 460497d2d16d2d9e53a4c964d67a3844 *R/solve-Rampl.R f6399901056b542dbf818249bb7c46cd *R/solve-Rdonlp2.R 449bca3f005111eb259c289a1279e556 *R/solve-RglpkMAD.R c810977fd7fe9434936b125eee39f2e6 *R/solve-RglpkVAR.R fa3fa0e752edc54e2400a1264e94b6a1 *R/solve-Ripop.R 6a6e50e72ef5b00a9dbc25981b7a2eb4 *R/solve-Rquadprog.R 7b8fa9e8fc7fa501993df546ad2ac083 *R/solve-RquadprogCLA.R 7c7f0eb6154e69e8fec3f490f9b4ac6a *R/solve-RshortExact.R 957c7ac2395ec633ccb1d3853b9ce3dd *R/solve-Rsocp.R ac68b9d18d143730cf5a7aa2814356e9 *R/solve-Rsolnp.R a14dd59f26f02d9ecc2259f694c03083 *R/solve-RtwoAssets.R 5ffa1a117cc651bd95d05b11d245c67b *R/solve-environment.R cb8e34e01ca59ff177182f558f370671 *R/utils-NLPgeneral.R 74cd15a5dc9285f24230c0c5065aae69 *R/utils-amplExec.R 81883f759ddd79f294f62b692aa6aba5 *R/utils-amplExtractors.R 6d6a1948fdf053e94055cddfdafad11f *R/utils-amplInterface.R 1dddd167af0e234308ca233a4a9640f4 *R/utils-amplLibrary.R 37757850b5e7f57851a86974bf2a41b4 *R/utils-exampleData.R ea143f9154560dd70050bbc2a60326ab *R/utils-methods.R e93dd92f5dbe044868304d1319a0ed93 *R/utils-specs.R 53208dc3190d0a1c729f80ce8767dea9 *R/zzz.R 3f6f1e2b421d7ea764fcd1dcf6589e72 *data/ECON85.csv.xz b9442c18b22008fedd0b914035abe701 *data/ECON85LONG.csv.xz a3893456d67029395b72e839de9293d2 *data/GCCINDEX.RET.rda 24a6e1fb9680595bee59db372d0139a4 *data/GCCINDEX.rda 2a6da561c27e50d63f4950387f08d853 *data/LPP2005.RET.rda cd28f41b006eef55495de18cc98df86d *data/LPP2005.rda e32832256057ae5f60ef432b5cf15e63 *data/SMALLCAP.RET.rda 7fb8458fde0cd77514f203b0de22f9a8 *data/SMALLCAP.rda 4bfaf79b9611f6a436331b58c8ee22ae *data/SPISECTOR.RET.rda ecc7620967b0e73559febb0be4474a71 *data/SPISECTOR.rda 1ee19cffd3d1f7f5cd82a5d3ca58edfd *data/SWX.RET.rda 58ff4dfeae6fe714d9ab1111007969f8 *data/SWX.rda d41d8cd98f00b204e9800998ecf8427e *inst/LICENSE_AMPL fe0cf809f11102c42dd811ff01c479e1 *inst/LICENSE_DONLP2 4a01a472db7fb700bd56c34b4c206375 *inst/LICENSE_GLPK f47716c075ed103781e2a77a0ede2477 *inst/LICENSE_QUADPROG ee15c3afc720f0b9f24f6196cdf5e3b8 *inst/LICENSE_SOCP fb62e6486baa854b494dbdc570262dd0 *inst/LICENSE_SOLNP bdb660a470a12c8332b05451868092f6 *inst/ReferenceCard.txt 445ae4c3417aa210e78a7cd3783db23c *inst/obsolete/zzz.Deprecated.R 8aa7b8e28557f52d9142b7ffcc710c42 *man/00fPortfolio-package.Rd 8068833535e7a78e2b56b37d738c9a10 *man/a-class-fPFOLIOBACKTEST.Rd 4630021f7d22f8343efb110ab9413224 *man/a-class-fPFOLIOCON.Rd 0146be7c56345243b568c06ed733cf34 *man/a-class-fPFOLIODATA.Rd b40cb881570942259ddcf5bcd0f6a03f *man/a-class-fPFOLIOSPEC.Rd c24a6d13bf34dff1fb5d01af4c71e473 *man/a-class-fPFOLIOVAL.Rd efff73ab6b138a3f34eacb823006c780 *man/a-class-fPORTFOLIO.Rd a2869ead43a6b3aeb85afa215867e91c *man/backtest-constructors.Rd f78270a190366e34d1a2d203f44469dc *man/backtest-extractors.Rd ebb9d61e97ace5d58b1d5fc06885a6de *man/backtest-functions.Rd 2a8a0ae0d1d0a4261414d61f46ed8f23 *man/backtest-getMethods.Rd 9fd641a6e8d4dad5137d25dc185ed66d *man/backtest-performance.Rd 87260a1f4021790d162888155dd2f852 *man/backtest-plots.Rd b743f80919381d17ea6cd52da1f44f73 *man/backtest-portfolios.Rd 3bfeea745a6eae129733d191711fd216 *man/backtest-specification.Rd 245559ad1b21a149b3e8d4134b52c459 *man/backtest-statisitics.Rd a937d3ec59b03e219f642da354818e93 *man/data-sets.Rd 2ab2d2bdfbe8b02bd399526a624455c9 *man/frontier-Plot.Rd 80190551c20f2f85713bc16904445a2c *man/frontier-PlotControl.Rd 1faf2fa7c3382ea7946c02ca7a5e4efd *man/frontier-Points.Rd 9feba53b7379bd0da2e5ffca5deb18de *man/mathprog-LP.Rd b49e8b256d179d10b1213df35d4289c3 *man/mathprog-NLP.Rd 16101ab5b26ddd6b4ac8c2478089d04c *man/mathprog-QP.Rd 71b648e90743c71d4f4d6d4d6888aaac *man/methods-plot.Rd d9b58bfcea01dcada88d9e915213a030 *man/methods-show.Rd be398146a051f2a342be788268eed0e0 *man/methods-summary.Rd c4daa0c54c65686d68262bc1b65f8396 *man/monitor-stability.Rd 66b32c4f92815ab8b0f489d7d279d281 *man/portfolio-Constraints.Rd 12dc225f41fd9beb58162b6dd8eb9a7c *man/portfolio-Data.Rd b0f8d94f96d3b470aa8f1d126d58fa45 *man/portfolio-Frontier.Rd 187a66070d0d8e0f03c169b6128c478e *man/portfolio-Rolling.Rd 983435404984e16cb6ccea506b42e48a *man/portfolio-covEstimator.Rd c7031be11b9febe458169d3fd65abb2b *man/portfolio-efficientPfolio.Rd be3fc69ac15412bf9d9d330fe53a1191 *man/portfolio-feasiblePfolio.Rd 4e0a5597b63da586dd3261a11d1531c2 *man/portfolio-getData.Rd d3783afcc576a683de4770001eb18431 *man/portfolio-getDefault.Rd aa2d15a0dfc62cf11ff729d3cfcccd25 *man/portfolio-getPortfolio.Rd dd865180d9ec78f73d60750258cbf1a0 *man/portfolio-getSpec.Rd 25397871d135713996abcb4a397855db *man/portfolio-getVal.Rd 589dcec5f66f04b214d03fec6fed306d *man/portfolio-pfolioRisk.Rd f3e52157e95c2b3904c535388f906bc5 *man/portfolio-portfolioSpec.Rd ae191a5b5dc3db2e2a6e84bbd8a4a6ef *man/portfolio-riskPfolio.Rd 7d6ab136392d6a25f11911b6b29fe34d *man/portfolio-setSpec.Rd 3364c894fba153f2a2053cb9e8f69c5c *man/risk-budgeting.Rd a054ee1b376736078ebcbf230a5664ac *man/risk-surfaceRisk.Rd e1d61f177c1aeb2cab0016e4c9d7d527 *man/risk-ternaryMap.Rd 1cb09c273225056e632bdda650989074 *man/solve-environment.Rd 865662e941bf529a6b1b759ea3b124a6 *man/solver-ampl.Rd ad861acd5ea8fb26675b724a53ae548c *man/solver-rfamily.Rd e0aac0b928d21c629cb2f2f52405e380 *man/utils-methods.Rd 2792ccc821cba4e52d2da0bc6fbf64d1 *man/weights-Slider.Rd 0eec377bb64237d1c1d6b9249c3e72e5 *man/weights-barPlots.Rd 3600dafd0e40154b8b71954f3d3c1890 *man/weights-linePlots.Rd 61c96ba4ffbe3879bdf134069fdde82d *man/weights-piePlots.Rd fPortfolio/inst/0000755000175100001440000000000013201353172013365 5ustar hornikusersfPortfolio/inst/obsolete/0000755000175100001440000000000013201353172015201 5ustar hornikusersfPortfolio/inst/obsolete/zzz.Deprecated.R0000644000175100001440000006701612323217772020243 0ustar hornikusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA ################################################################################ # FUNCTION: DESCRIPTION: # .mvnormFit Fits a multivariate Normal distribution # .mvsnormFit Fits a multivariate skew-Normal distribution # .mvstFit Fits a multivariate skew-Student-t distribution # FUNCTION: DESCRIPTION: # .assetsStats Computes statistics of monthly assets sets # FUNCTION: DESCRIPTION: # .dutchPortfolioData Example Data from Engel's Diploma Thesis # .usPortfolioData Annual US Economics Portfolio Data # .sm132PortfolioData Example from Scherer, Martin: Chapter 1.32 # .worldIndexData A data set of World Indexes # FUNCTION: DESCRIPTION: # fixBinHistogram Returns histogram with fixed bins ################################################################################ .mvnormFit <- function(x, title=NULL, description=NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Fits a multivariate Normal distribution # Arguments: # x - A multivariate time series, a data frame, or any other # rectangular object of assets which can be converted into # a matrix by the function as.matrix. Optional Dates are # rownames, instrument names are column names. # Value: # The function returns a list with the following entries: # mu - Mean values of each asset time series # Omega - Covariance matrix of assets # Notes: # Requires function "msn.mle" ans "mst.mle" from R's GPL licensed # contributed package "sn", (C) 1998-2004 A. Azzalini. # The list returned by this function can serve as input for the # function assetsSim(). # FUNCTION: # Settings: assets = as.matrix(x) method = method[1] colNames = colnames(x) # Fit mvNormal: fit = list() mu = apply(assets, 2, mean) Omega = cov(assets) alpha = rep(0, times = length(mu)) df = Inf # Add Names: names(mu) = colNames names(alpha) = colNames rownames(Omega) = colNames colnames(Omega) = colNames # Add Title: if (is.null(title)) title = paste("Fitted Asset Data Model: ", method) # Add Description: if (is.null(description)) description = description() # Return Value: new("fASSETS", call = as.call(match.call()), method = as.character(method), model = list(mu = mu, Omega = Omega, alpha = alpha, df = df), data = as.data.frame(x), fit = as.list(fit), title = as.character(title), description = as.character(description) ) } # ------------------------------------------------------------------------------ .mvsnormFit <- function(x, title=NULL, description=NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Fits a multivariate skew-Normal distribution # Arguments: # x - A multivariate time series, a data frame, or any other # rectangular object of assets which can be converted into # a matrix by the function as.matrix. Optional Dates are # rownames, instrument names are column names. # Value: # The function returns a list with the following entries: # mu - Mean values of each asset time series # Omega - Covariance matrix of assets # alpha - Skewness vector # Notes: # Requires function "msn.mle" ans "mst.mle" from R's GPL licensed # contributed package "sn", (C) 1998-2004 A. Azzalini. # The list returned by this function can serve as input for the # function assetsSim(). # FUNCTION: # Settings: assets = as.matrix(x) method = method[1] colNames = colnames(x) # Fit skew-Normal: fit = mvFit(assets, method = "snorm", ...) mu = as.vector(fit@fit$dp$beta) Omega = fit@fit$dp$Omega alpha = as.vector(fit@fit$dp$alpha) df = Inf fit = fit@fit # Add Names: names(mu) = colNames names(alpha) = colNames rownames(Omega) = colNames colnames(Omega) = colNames # Add Title: if (is.null(title)) title = paste("Fitted Asset Data Model: ", method) # Add Description: if (is.null(description)) description = description() # Return Value: new("fASSETS", call = as.call(match.call()), method = as.character(method), model = list(mu = mu, Omega = Omega, alpha = alpha, df = df), data = as.data.frame(x), fit = as.list(fit), title = as.character(title), description = as.character(description) ) } # ------------------------------------------------------------------------------ .mvstFit <- function(x, title = NULL, description=NULL, fixed.df=NA, ...) { # A function implemented by Diethelm Wuertz # Description: # Fits a multivariate skew-Student-t distribution # Arguments: # x - A multivariate time series, a data frame, or any other # rectangular object of assets which can be converted into # a matrix by the function as.matrix. Optional Dates are # rownames, instrument names are column names. # Value: # The function returns a list with the following entries: # mu - Mean values of each asset time series # Omega - Covariance matrix of assets # alpha - Skewness vector # df - Degrees of freedom, measures kurtosis # Notes: # Requires function "msn.mle" ans "mst.mle" from R's GPL licensed # contributed package "sn", (C) 1998-2004 A. Azzalini. # The list returned by this function can serve as input for the # function assetsSim(). # FUNCTION: # Settings: assets = as.matrix(x) method = method[1] colNames = colnames(x) # Fit skew-Student: fit = mvFit(assets, method = "st", fixed.df = fixed.df, ...) mu = as.vector(fit@fit$beta) Omega = fit@fit$dp$Omega alpha = as.vector(fit@fit$dp$alpha) df = fit@fit$dp$df fit = fit@fit # Add Names: names(mu) = colNames names(alpha) = colNames rownames(Omega) = colNames colnames(Omega) = colNames # Add Title: if (is.null(title)) title = paste("Fitted Asset Data Model: ", method) # Add Description: if (is.null(description)) description = description() # Return Value: new("fASSETS", call = as.call(match.call()), method = as.character(method), model = list(mu = mu, Omega = Omega, alpha = alpha, df = df), data = as.data.frame(x), fit = as.list(fit), title = as.character(title), description = as.character(description) ) } ################################################################################ .hclustSelect <- function(x, control = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Hierarchical Clustering # FUNCTION: # Method: if (is.null(control)) control = c(measure = "euclidean", method = "complete") measure = control[1] method = control[2] # hclust: ans = hclust(dist(t(x), method = measure), method = method, ...) class(ans) = c("list", "hclust") # Return Value: ans } # ----------------------------------------------------------------------------- .kmeansSelect <- function(x, control = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # kmeans Clustering # Note: # centers must be specified by the user! # FUNCTION: # Method: if (is.null(control)) control = c(centers = 5, algorithm = "Hartigan-Wong") centers = as.integer(control[1]) algorithm = control[2] # kmeans: ans = kmeans(x = t(x), centers = centers, algorithm = algorithm, ...) class(ans) = c("list", "kmeans") # Return Value: ans } ################################################################################ .assetsStats <- function(x) { # A function implemented by Diethelm Wuertz # Description: # Computes benchmark statistics for a data set of assets with # monthly data records. # Details: # The computed statistics values are: # records - number of records (length of time series) # paMean - annualized (pa, per annum) Mean of Returns # paAve - annualized Average of Returns # paVola - annualized Volatility (standard Deviation) # paSkew - Skewness of Returns # paKurt - Kurtosis of Returns # maxDD - maximum Drawdown # TUW - Time under Water # mMaxLoss - Monthly maximum Loss # mVaR - Monthly 99% Value-at-Risk # mModVaR - Monthly 99% Modified Value-at-Risk # mSharpe - Monthly Sharpe Ratio # mModSharpe - Monthly Modified Sharpe Ratio # skPrice - Skewness/Kurtosis Price # The statistics are implemented based on the formulas from # "Extreme Metrics". They reflect risk measures as used in # the hedge fund software from "www.AlternativeSoft.com". # Arguments: # x - asset data set, a matrix (or vector) where the rows # are numbered by "time", and the columns belong to the # individual assets. Monthly values are expected. # Value: # The function returns a data frame with the values of the # 12 statistics for each asset. # Reference: # "ExtremeMetrics Software", Help Document, Alternative Software, # March 2003, 4 pages. # Example: # FUNCTION: # If x is a vector, make it a matrix: statistics = 14 if (is.null(dim(x))) { n = 1 x = matrix(x, length(x)) result = matrix(rep(0, times = statistics), ncol = 1) } else { n = dim(x)[2] result = matrix(rep(0, times = statistics*n), ncol = n) } # Give Names to Result Matrix: stat.names = c( "Records", "paMean", "paAve", "paVola", "paSkew", "paKurt", "maxDD", "TUW", "mMaxLoss", "mVaR", "mModVaR", "mSharpe", "mModSharpe", "skPrice") dimnames(result) = list(stat.names, dimnames(x)[[2]]) # Loop over all Assets: for (i in 1:n) { r = x[, i] # Number of Records: result[1, i] = length(r) # Annualized mean from monthly returns: result[2, i] = annualizedMean = (1 + mean(r))^12 - 1 # Annualized mean from monthly returns: result[3, i] = annualizedAverage = mean(r)*sqrt(12) # Annualized volatility from monthly returns: result[4, i] = annualizedVolatility = sqrt(var(r)) # Annualized skewness from monthly returns: result[5, i] = annualizedSkewness = skewness(r) # Annualized Kurtosis from monthly returns: result[6, i] = annualizedKurtosis = kurtosis(r) # Maximum Drawdown of of monthly returns: result[7, i] = maxDrawdown = max(cummax(cumsum(r)) - cumsum(r)) # Time-Under-Water of monthly returns: result[8, i] = timeUnderWater = max(diff(which (diff(cummax(cumsum(r))) != 0))) # Maximum Loss of monthly returns: result[9, i] = maxMonthlyLoss = min(r) # Monthly Value at Risk: zc = 2.33 result[10, i] = monthlyVaR = annualizedMean - zc * annualizedVolatility # Monthly Modified Value at Risk: p = 0.99; s = annualizedSkewness; k = annualizedKurtosis zcf = zc + (zc*zc-1)*s/6 + zc*(zc*zc-3)*k/24 + zc*(2*zc*zc-5)*s*s/36 result[11, i] = monthlyModVaR = annualizedMean - zcf * annualizedVolatility # Monthly Sharpe Ratio: result[12, i] = monthlySharpeRatio = annualizedMean/annualizedVolatility # Monthly Modified Sharpe Ratio: result[13, i] = monthlyModSharpeRatio = annualizedMean/monthlyModVaR # Skewness Kurtosis Price: result[14, i] = skewnesskurtosisPrice = annualizedMean * ( monthlyModVaR/monthlyVaR - 1) } # Result: ans = as.data.frame(round(result, digits = 3)) # Return Value: ans } ################################################################################ .dutchPortfolioData = function() { # A function implemented by Rmetrics # Description: # Example Portfolio Data from Engels # Example: # engelsPortfolioData() # FUNCTION: # Mean Returns: mu = c(0.266, 0.274, 0.162, 0.519, 0.394, 0.231, 0.277) / 1000 names(mu) = c( "Elsevier", "Fortis", "Getronics", "Heineken", "Philips", "RoyalDutch", "Unilever") # Variance-Covariance Risk: Sigma = c( 0.345, 0.150, 0.183, 0.088, 0.186, 0.090, 0.095, 0.150, 0.399, 0.204, 0.107, 0.236, 0.130, 0.127, 0.183, 0.204, 1.754, 0.075, 0.325, 0.110, 0.091, 0.088, 0.107, 0.075, 0.243, 0.096, 0.064, 0.086, 0.186, 0.236, 0.325, 0.096, 0.734, 0.147, 0.114, 0.090, 0.130, 0.110, 0.064, 0.147, 0.221, 0.093, 0.095, 0.127, 0.091, 0.086, 0.114, 0.093, 0.219) Sigma = matrix(Sigma, ncol = 7) colnames(Sigma) = rownames(Sigma) = names(mu) # Return Value: list(mu = mu, Sigma = Sigma) } # ------------------------------------------------------------------------------ .usPortfolioData = function() { # A function implemented by Rmetrics # Description: # Annual US Economics Portfolio Data # Example: # usPortfolioData() # list(mu = round(mean(usPortfolioData()),5), # Sigma = round(var(usPortfolioData()), 5)) # FUNCTION: # Units: Units = c("TBills3m", "LongBonds", "SP500", "Wilshire5000", "NASDAQComp", "LehmanBonds", "EAFE", "Gold") # Time Series Object: tS = as.timeSeries(as.data.frame(matrix(c( 19731231,1.075,0.942,0.852,0.815,0.698,1.023,0.851,1.677, 19741231,1.084,1.020,0.735,0.716,0.662,1.002,0.768,1.722, 19751231,1.061,1.056,1.371,1.385,1.318,1.123,1.354,0.760, 19761231,1.052,1.175,1.236,1.266,1.280,1.156,1.025,0.960, 19771231,1.055,1.002,0.926,0.974,1.093,1.030,1.181,1.200, 19781231,1.077,0.982,1.064,1.093,1.146,1.012,1.326,1.295, 19791231,1.109,0.978,1.184,1.256,1.307,1.023,1.048,2.212, 19801231,1.127,0.947,1.323,1.337,1.367,1.031,1.226,1.296, 19811231,1.156,1.003,0.949,0.963,0.990,1.073,0.977,0.688, 19821231,1.117,1.465,1.215,1.187,1.213,1.311,0.981,1.084, 19831231,1.092,0.985,1.224,1.235,1.217,1.080,1.237,0.872, 19841231,1.103,1.159,1.061,1.030,0.903,1.150,1.074,0.825, 19851231,1.080,1.366,1.316,1.326,1.333,1.213,1.562,1.006, 19861231,1.063,1.309,1.186,1.161,1.086,1.156,1.694,1.216, 19871231,1.061,0.925,1.052,1.023,0.959,1.023,1.246,1.244, 19881231,1.071,1.086,1.165,1.179,1.165,1.076,1.283,0.861, 19891231,1.087,1.212,1.316,1.292,1.204,1.142,1.105,0.977, 19901231,1.080,1.054,0.968,0.938,0.830,1.083,0.766,0.922, 19911231,1.057,1.193,1.304,1.342,1.594,1.161,1.121,0.958, 19921231,1.036,1.079,1.076,1.090,1.174,1.076,0.878,0.926, 19931231,1.031,1.217,1.100,1.113,1.162,1.110,1.326,1.146, 19941231,1.045,0.889,1.012,0.999,0.968,0.965,1.078,0.990), byrow = TRUE, ncol = 9))) colnames(tS)<-Units # Return Value: tS } # ------------------------------------------------------------------------------ .sm132PortfolioData = function() { # A function implemented by Rmetrics # Description: # Example from Scherer, Martin: "Modern Portfolio Omtimization": # Cheapter 1.32 # FUNCTION: corr = matrix(data = c( 1, 0.4, 0.5, 0.5, 0.4, 0.1, 0.1, 0.1, 0.4, 1.0, 0.3, 0.3, 0.1, 0.4, 0.1, 0.1, 0.5, 0.3, 1.0, 0.7, 0.1, 0.1, 0.5, 0.1, 0.5, 0.3, 0.7, 1.0, 0.1, 0.1, 0.1, 0.5, 0.4, 0.1, 0.1, 0.1, 1.0, 0.0, 0.0, 0.0, 0.1, 0.4, 0.1, 0.1, 0.0, 1.0, 0.0, 0.0, 0.1, 0.1, 0.5, 0.1, 0.0, 0.0, 1.0, 0.2, 0.1, 0.1, 0.1, 0.5, 0.0, 0.0, 0.2, 1.0), nrow = 8, ncol = 8) vol = diag(c(17, 21, 22, 20, 8, 8, 8, 8)) Cov = vol %*% corr %*% vol # Average return mu = c(3, 4, 5, 6, 0.25, 0.5, 0.75, 1) # Return value: list(mu = mu, Sigma = Cov) } # ------------------------------------------------------------------------------ .worldIndexData = function() { # Description: # A data set of World Indexs contributed by Dominik Locher # Units: Units = c("Asia", "EasternEurope", "FarEast", "LatinAmerica") # Time Series Object: x = c( 20070327,370.04,302.41,326.56,3100.66, 20070326,370.37,304.79,327.06,3128.91, 20070325,369.54,302.25,326.03,3124.70, 20070324,369.54,302.25,326.03,3124.70, 20070323,369.54,302.25,326.03,3124.70, 20070322,369.75,298.95,326.26,3129.17, 20070321,365.46,292.45,322.84,3116.79, 20070320,362.57,289.46,320.86,3034.35, 20070319,360.93,292.24,319.81,2990.89, 20070318,357.70,287.29,317.28,2938.57, 20070317,357.70,287.29,317.28,2938.57, 20070316,357.70,287.29,317.28,2938.57, 20070315,357.74,285.52,317.04,2962.38, 20070314,353.26,281.37,312.66,2936.81, 20070313,362.26,285.91,320.23,2930.81, 20070312,362.09,286.35,320.47,3014.71, 20070311,357.45,288.41,315.81,3004.10, 20070310,357.45,288.41,315.81,3004.10, 20070309,357.45,288.41,315.81,3004.10, 20070308,357.38,281.80,315.42,2964.89, 20070307,350.68,278.35,310.37,2901.26, 20070306,349.63,278.58,308.97,2910.81, 20070305,342.19,273.38,302.54,2797.08, 20070304,357.72,282.62,316.19,2880.75, 20070303,357.72,282.62,316.19,2880.75, 20070302,357.72,282.62,316.19,2880.75, 20070301,359.75,280.80,317.25,2925.88, 20070228,363.46,290.20,321.72,2957.57, 20070227,372.72,297.04,329.05,2933.25, 20070226,377.55,308.41,333.45,3143.55, 20070225,378.21,304.53,334.12,3152.57, 20070224,378.21,304.53,334.12,3152.57, 20070223,378.21,304.53,334.12,3152.57, 20070222,379.11,303.81,334.01,3198.17, 20070221,378.44,300.74,332.64,3166.70, 20070220,377.83,300.17,331.72,3157.26, 20070219,377.94,303.03,331.21,3166.05, 20070218,378.26,301.19,331.53,3162.13, 20070217,378.26,301.19,331.53,3162.13, 20070216,378.26,301.19,331.53,3162.13, 20070215,377.28,299.89,330.64,3172.06, 20070214,372.47,301.38,327.11,3172.37, 20070213,368.75,295.28,323.16,3112.62, 20070212,372.40,289.73,326.33,3049.67, 20070211,376.56,297.99,329.20,3081.50, 20070210,376.56,297.99,329.20,3081.50, 20070209,376.56,297.99,329.20,3081.50, 20070208,376.37,298.04,328.56,3111.51, 20070207,376.14,305.12,328.39,3111.97, 20070206,374.87,306.71,327.71,3123.29, 20070205,372.22,304.55,324.90,3105.70, 20070204,370.91,302.47,324.03,3096.00, 20070203,370.91,302.47,324.03,3096.00, 20070202,370.91,302.47,324.03,3096.00, 20070201,366.10,302.61,319.70,3080.11, 20070131,362.92,296.93,317.05,3041.84, 20070130,365.45,293.86,319.34,2994.49, 20070129,363.99,293.20,317.87,2959.63, 20070128,365.73,295.87,319.48,3008.45, 20070127,365.73,295.87,319.48,3008.45, 20070126,365.73,295.87,319.48,3008.45, 20070125,371.24,299.37,325.03,3031.37, 20070124,372.54,298.33,326.91,3050.37, 20070123,367.71,297.63,322.26,3005.14, 20070122,368.07,297.03,322.01,2965.56, 20070121,366.07,292.74,320.23,2954.21, 20070120,366.07,292.74,320.23,2954.21, 20070119,366.07,292.74,320.23,2954.21, 20070118,368.51,289.85,322.62,2901.66, 20070117,366.67,288.32,320.87,2926.80, 20070116,367.78,292.91,322.15,2908.26, 20070115,366.66,296.45,320.98,2933.52, 20070114,361.66,288.98,316.46,2926.08, 20070113,361.66,288.98,316.46,2926.08, 20070112,361.66,288.98,316.46,2926.08, 20070111,354.97,290.37,311.21,2902.35, 20070110,354.90,285.22,311.93,2859.72, 20070109,361.15,288.23,317.46,2849.87, 20070108,362.10,304.41,318.23,2903.84, 20070107,367.47,304.32,322.78,2880.09, 20070106,367.47,304.32,322.78,2880.09, 20070105,367.47,304.32,322.78,2880.09, 20070104,370.65,307.56,325.92,2968.18, 20070103,376.06,310.53,331.11,3002.63, 20070102,377.21,311.52,332.33,3039.15, 20070101,371.46,309.43,327.07,2995.67, 20061231,371.46,309.43,327.07,2995.67, 20061230,371.46,309.43,327.07,2995.67, 20061229,371.46,309.43,327.07,2995.67, 20061228,370.18,307.74,325.65,2981.90, 20061227,368.11,304.17,323.63,2975.56, 20061226,363.36,300.91,319.54,2926.69, 20061225,362.36,301.54,319.41,2902.57, 20061224,362.60,302.53,319.65,2902.57, 20061223,362.60,302.53,319.65,2902.57, 20061222,362.60,302.53,319.65,2902.57, 20061221,361.54,304.50,318.98,2910.08, 20061220,361.98,304.64,319.70,2918.35, 20061219,356.34,300.35,313.84,2917.11, 20061218,363.09,306.87,319.50,2936.06, 20061217,360.37,306.83,317.06,2942.70, 20061216,360.37,306.83,317.06,2942.70, 20061215,360.37,306.83,317.06,2942.70, 20061214,358.11,305.14,315.26,2938.00, 20061213,352.99,302.33,311.23,2903.05, 20061212,352.75,304.36,311.64,2890.34, 20061211,356.43,305.03,314.04,2907.91, 20061210,358.28,308.42,314.60,2895.92, 20061209,358.28,308.42,314.60,2895.92, 20061208,358.28,308.42,314.60,2895.92, 20061207,363.08,308.81,318.78,2889.90, 20061206,363.95,308.24,319.82,2891.55, 20061205,362.05,308.20,317.71,2887.74, 20061204,359.44,303.24,315.40,2836.95, 20061203,360.01,300.45,316.12,2780.48, 20061202,360.01,300.45,316.12,2780.48, 20061201,360.01,300.45,316.12,2780.48, 20061130,358.40,299.50,315.12,2804.62, 20061129,354.34,296.95,311.25,2789.24, 20061128,350.48,288.78,307.40,2726.65, 20061127,356.66,287.56,312.97,2732.92, 20061126,354.96,287.21,311.34,2782.22, 20061125,354.96,287.21,311.34,2782.22, 20061124,354.96,287.21,311.34,2782.22, 20061123,354.65,285.92,311.04,2791.43, 20061122,353.85,284.78,310.34,2787.78, 20061121,349.05,284.25,305.82,2767.77, 20061120,347.46,278.95,304.95,2740.54, 20061119,348.12,281.08,305.55,2735.42, 20061118,348.12,281.08,305.55,2735.42, 20061117,348.12,281.08,305.55,2735.42, 20061116,348.96,285.75,306.06,2761.74, 20061115,347.24,283.87,304.79,2766.90, 20061114,346.29,284.29,303.74,2760.15, 20061113,343.74,283.69,301.17,2721.09, 20061112,343.78,284.11,301.32,2733.62, 20061111,343.78,284.11,301.32,2733.62, 20061110,343.78,284.11,301.32,2733.62, 20061109,343.01,283.30,300.81,2750.00, 20061108,339.56,280.29,297.78,2750.76, 20061107,340.64,282.54,298.59,2739.01, 20061106,337.81,277.43,295.87,2743.48, 20061105,338.56,275.49,296.72,2687.33, 20061104,338.56,275.49,296.72,2687.33, 20061103,338.56,275.49,296.72,2687.33, 20061102,336.80,272.81,295.09,2666.32, 20061101,333.81,277.98,292.27,2673.55, 20061031,331.68,270.93,290.50,2663.66, 20061030,330.43,266.78,288.86,2619.44, 20061029,331.79,274.60,290.85,2667.38, 20061028,331.79,274.60,290.85,2667.38, 20061027,331.79,274.60,290.85,2667.38, 20061026,331.41,276.15,291.20,2698.02, 20061025,329.05,275.38,289.16,2688.38, 20061024,328.31,272.69,288.43,2668.66, 20061023,326.76,271.96,286.86,2654.76, 20061022,328.10,274.18,287.91,2637.77, 20061021,328.10,274.18,287.91,2637.77, 20061020,328.10,274.18,287.91,2637.77, 20061019,326.66,277.17,286.40,2651.84, 20061018,327.51,274.63,286.91,2636.09, 20061017,328.14,270.77,287.48,2619.25, 20061016,329.36,271.73,288.66,2649.86, 20061015,326.89,273.78,286.76,2625.68, 20061014,326.89,273.78,286.76,2625.68, 20061013,326.89,273.78,286.76,2625.68, 20061012,322.28,267.06,282.92,2579.95, 20061011,320.70,267.86,282.06,2558.04, 20061010,320.94,266.72,282.39,2573.41, 20061009,319.22,268.07,280.62,2547.12, 20061008,323.44,262.86,284.71,2530.23, 20061007,323.44,262.86,284.71,2530.23, 20061006,323.44,262.86,284.71,2530.23, 20061005,323.43,265.18,284.83,2535.34, 20061004,320.04,259.29,282.16,2505.77, 20061003,323.99,256.38,285.66,2449.38, 20061002,323.89,261.75,285.40,2482.37, 20061001,322.90,260.28,284.41,2473.06, 20060930,322.90,260.28,284.41,2473.06, 20060929,322.90,260.28,284.41,2473.06) tS = as.timeSeries(data.frame(matrix(x, byrow = TRUE, ncol = 5))) tS = returns(rev(tS)) colnames(tS)<-Units # Return Value: tS } ################################################################################ .hist <- function (x, nbins) { # A function implemented by Diethelm Wuertz # Description: # Returns histogram with fixed bins # FUNCTION: # Classes: nclass = nbins + 1 n = length(x) xname = paste(deparse(substitute(x), 500), collapse = "\n") # Breaks: breaks = seq(min(x), max(x), length = nclass) nB = length(breaks) h = diff(breaks) # Compute Counts: counts = .C("bincount", as.double(x), as.integer(n), as.double(breaks), as.integer(nB), counts = integer(nB - 1), right = FALSE, include = TRUE, naok = FALSE, NAOK = FALSE, DUP = FALSE, PACKAGE = "base")$counts dens = counts/(n * h) mids = 0.5 * (breaks[-1] + breaks[-nB]) # Histogram: r = structure(list(breaks = breaks, counts = counts, intensities = dens, density = dens, mids = mids, xname = xname, equidist = TRUE), class = "histogram") } ################################################################################ fPortfolio/inst/LICENSE_SOCP0000644000175100001440000000127512323217772015234 0ustar hornikusers--- This is the beta version of SOCP --- COPYRIGHT (c) 1997 Miguel Sousa Lobo, Lieven Vandenberge, Stephen Boyd, Herve Lebret. Permission to use, copy, modify, and distribute this software for any purpose without fee is hereby granted, provided that this entire notice is included in all copies of any software which is or includes a copy or modification of this software and in all copies of the supporting documentation for such software. This software is being provided "as is", without any express or implied warranty. In particular, the authors do not make any representation or warranty of any kind concerning the merchantability of this software or its fitness for any particular purpose.fPortfolio/inst/LICENSE_AMPL0000644000175100001440000000000012323217772015202 0ustar hornikusersfPortfolio/inst/LICENSE_QUADPROG0000644000175100001440000000144712323217772015713 0ustar hornikusersc c Copyright (C) 1995 Berwin A. Turlach c c This program is free software; you can redistribute it and/or modify c it under the terms of the GNU General Public License as published by c the Free Software Foundation; either version 2 of the License, or c (at your option) any later version. c c This program is distributed in the hope that it will be useful, c but WITHOUT ANY WARRANTY; without even the implied warranty of c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the c GNU General Public License for more details. c c You should have received a copy of the GNU General Public License c along with this program; if not, write to the Free Software c Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, c USA. fPortfolio/inst/LICENSE_SOLNP0000644000175100001440000000237012323217772015360 0ustar hornikusersFrom: Yinyu Ye [yinyu-ye AT stanford.edu] Sent: Wednesday, May 20, 2009 3:10 PM To: Ghalanos, Alexios Cc: Veinott Jr. Veinott; Yinyu Ye Subject: Re: solnp This is fine to me. Regards, Yinyu At 01:51 AM 5/20/2009, Ghalanos, Alexios wrote: > Dear Professor Ye, > > We would like to obtain your permission, if possible, to release > under the GPL license our translation of your solnp solver into R > (www.r-project.org). > We have found it to be quite robust in financial optimization and > time series likelihood problems, and given that R does not benefit > from a general > non linear solver we would like to release a package based on solnp. > We have already translated the routines into R and we would also be looking to > possibly translate them into C as well for greater speed (interfaced via R). > > The R community is made up of diverse researchers across many > disciplines from around the world and depends on the contribution of others to > enable open source research in science and academia. > > We greatly appreciate you consideration of this request. > > With kind regards, > > Alexios Ghalanos > for the > Integer and Nonlinear Optimization in R (RINO) project > https://r-forge.r-project.org/projects/rino/fPortfolio/inst/ReferenceCard.txt0000644000175100001440000014271312323217772016637 0ustar hornikusers PACKAGE: fPortfolio The functions listed in this reference card are available from the CRAN server, its development version can be downloaded from the r-forge Server. REFERENCE CARD: assets-arrange.R assetsArrange Rearranges the columns in a data set of assets statsArrange Returns statistically reordered column names pcaArrange Returns PCA correlation ordered column names hclustArrage Returns hierarchical clustered column names abcArrage Returns alphabetically sorted column names orderArrange Returns permuted column names sampleArrage Returns randomly sampled column names assets-dist.R assetsDist Computes the distances between assets corDist Returns correlation distance measure kendallDist Returns kendalls correlation distance measure spearmanDist Returns spearmans correlation distance measure mutinfoDist Returns mutual information distance measure euclideanDist Returns Euclidean distance measure maximumDist Returns maximum distance measure manhattanDist Returns Manhattan distance measure canberraDist Returns Canberra distance measure binaryDist Returns binary distance measure minkowskiDist Returns Minkowsky distance measure braycurtisDist Returns Bray Curtis distance measure mahalanobisDist Returns Mahalanobis distance measure jaccardDist Returns Jaccard distance mesaure differenceDist Returns difference distance measure sorensenDist Returns Sorensen distance measure assets-fit.R assetsFit Fits the parameters of a set of assets mvnormFit Fits a multivariate Normal distribution mvsnormFit Fits a multivariate skew-Normal distribution mvstFit Fits a multivariate skew-Student-t distribution assets-lpm.R assetsLPM Computes asymmetric lower partial moments assetsSLPM Computes symmetric lower partial moments assets-meancov.R assetsMeanCov Estimates mean and variance for a set of assets .covMeanCov uses sample covariance estimation .mveMeanCov uses "cov.mve" from [MASS] .mcdMeanCov uses "cov.mcd" from [MASS] .studentMeanCov uses "cov.trob" from [MASS] .MCDMeanCov uses "covMcd" from [robustbase] .OGKMeanCov uses "covOGK" from [robustbase] .nnveMeanCov uses builtin from [covRobust] .shrinkMeanCov uses builtin from [corpcor] .baggedMeanCov uses builtin from [corpcor] .arwMeanCov uses builtin from [mvoutlier] .donostahMeanCov uses builtin from [robust] .bayesSteinMeanCov uses code borrowed from Alexios Ghalanos .ledoitWolfMeanCov uses builtin from [tawny] .rmtMeanCov uses builtin from [tawny] getCenterRob Extracts the robust estimate for the center getCovRob Extracts the robust estimate for the covariance assets-outliers.R assetsOutliers Detects outliers in multivariate assets sets assets-portfolio.R pfolioVaR Computes VaR for a portfolio of assets pfolioCVaR Computes CVaR for a portfoluio of assets pfolioCVaRplus Computes CVaR-Plus for a portfolio of assets lambdaCVaR Computes CVaR's atomic split value lambda pfolioMaxLoss Computes maximum loss for a portfolio pfolioReturn Computes return series for a portfolio pfolioTargetReturn Computes target return for a portfolio pfolioTargetRisk Computes target risk for a portfolio pfolioHist Plots a histogram of portfolio returns assets-resolution.R [should go to 'timeSeries' package?] asMonthly Converts a timeSeries into an end-of-month series asAnnual Converts a timeSeries into an end-of-year series asDecades Converts a timeSeries into an end-of-decade series assets-select.R assetsSelect Selects similar or dissimilar assets hclustSelect Selects assets due to hierarchical clustering kmeansSelect Selects assets due to k-means clustering assets-simulate.R assetsSim Simulates a set of artificial assets assets-test.R assetsTest Tests for multivariate Normal Assets mvshapiroTest Multivariate Shapiro Test mvenergyTest Multivariate E-Statistic (Energy) Test ----------------------------------------------------------------------------------------- backtest-defaultFunctions.R equidistWindows Defines default equal distant rolling windows tangencyStrategy Defines default tangency strategy portfolio emaSmoother Defines default EMA weights smoother backtest-getBacktestSpec.R getWindows Extracts windows slot getWindowsFun Extracts name of windows function getWindowsParams Extracts a list of windows specific parameters getWindowsHorizon Extracts windows horizon getStrategy Extracts strategy slot getStrategyFun Extracts the name of portfolio strategy function getStrategyParams Extracts a list of strategy specific parameters getSmoother Extracts the smoother slot getSmootherFun Extracts the name of the moother function getSmootherParams Extracts a list of smoothing specific parameters getSmootherLambda Extracts the smoothing parameter Lambda getSmootherDoubleSmoothing Extracts setting for double smoothing getSmootherInitialWeights Extracts the initial weights in the smoothing getSmootherSkip Extracts the number of skipped months getMessages Extracts the message slot backtest-getMethods.R getWindows Extracts windows information getWindowsFun Extracts windows function getWindowsParams Extracts windows function parameters getWindowsHorizon Extracts windows Horizon getStrategy Extracts strategy information getStrategyFun Extracts strategy function getStrategyParams Extracts strategy function parameters getSmoother Extracts smoother information getSmootherFun Extracts smoother function getSmootherParams Extracts smoother function parameters getSmootherLambda Extracts decay parameter getSmootherDoubleSmoothing Extracts double smoothing flag getSmootherInitialWeights Extracts initial weights getSmootherSkip Extracs skip smoothing flag getMessages Extracts messages backtest-methodsShow.R show.fPFOLIOBACKTEST Print method for 'fPFOLIOBACKTEST' objects backtest-netPerformance.R netPerformance Returns performance from a portfolio backtest .netPerformanceYTD Returns year-to-date performance .netPerformanceCalendar Returns calendar performance .netPerformancePlot Creates a net performance plot backtest-pfolioBacktest.R portfolioBacktesting Performs a portfolio backtesting portfolioSmoothing Smoothes the weights of a portfolio backtesting backtest-pfolioBacktestSpec.R portfolioBacktest Returns an object of class 'fPFOLIOBACKTEST' backtest-plots.R backtestPlot Creates a summary of backtesting plots backtestAssetsPlot Plots assets used in a portfolio backtest backtestWeightsPlot Plots recommended weights from a backtest backtestRebalancePlot Plots rebalanced weights of a backtest backtestPortfolioPlot Plots benchmark and portfolio series backtestDrawdownPlot Plots the drawdown of the portfolio backtest backtestReportPlot Prints backtest report backtest-rollingStats.R backtestStats Wrapper function for calculating rolling statistics rollingSigma Rolling portfolio Sigma risk rollingVaR Rolling Value at Risk rollingCVaR Rolling Conditional Value at Risk rollingDar Rolling Drawdowns at Risk rollingCDaR Rolling Conditional Drawdowns at Risk backtest-setBacktestSpec.R setWindowsFun<- Sets name of rolling windows function setWindowsParams<- Sets additional parameters to windows function setWindowsHorizon<- Sets horizon of the rolling window setStrategyFun<- Sets name of portfolio strategy function setStrategyParams<- Sets additional parameters to strategy function setSmootherFun<- Sets name of weights smoothing function setSmootherParams<- Sets additional parameters to smoother function setSmootherLambda<- Sets lambda for EMA smoothing setSmootherDoubleSmoothing<- Sets double ema setting, logical setSmootherInitialWeights<- Sets initial weights of the portfolio setSmootherSkip<- Sets number of months to skip starting ----------------------------------------------------------------------------------------- builtin-*.R builtin-arwMvoutlier builtin-baggedCorpcor builtin-BayesStein builtin-corrgram builtin-distEcodist builtin-donostahRobust builtin-mstApe builtin-nnveCovRobust builtin-ogkRrcov builtin-rmtTawney builtin-shrinkCorpcor builtin-shrinkTawney builtin-solveRdeoptim builtin-testEnergy ----------------------------------------------------------------------------------------- frontier-getPoints.R frontierPoints Extracts frontier points frontier-portfolioPlots.R frontierPlot Plots efficient frontier minvariancePoints Adds minimum variance point cmlPoints Adds market portfolio cmlLines Adds capital market Line tangencyPoints Adds tangency portfolio point tangencyLines Adds tangency line equalWeightsPoints Adds point of equal weights portfolio singleAssetPoints Adds points of single asset portfolios twoAssetsLines Adds EF for all combinations of two assets sharpeRatioLines Adds Sharpe ratio line monteCarloPoints Adds randomly produced feasible portfolios frontierPlotControl Sets frontier plot control parameters tailoredFrontierPlot Tailored frontier plot wit addons frontier-weightPlots.R .weightsWheel Adds a pie of weights to frontier plot .attributesWheel Adds a pie of attributes to frontier plot .notStackedWeightsPlot Plots the not stacked weights of potfolio .addlegend Adds legend to sliders ----------------------------------------------------------------------------------------- mathprogLP.R rsolveLP General Interface for LP solvers .solveLP.MAD.demo Demonstation Example .solveLP.GLPK.demo Demonstation Example mathprogLP-ampl.R ramplLP Rmetrics Interface for AMPL LP solvers amplLP Convenience wrapper for AMPL LP solvers amplLPControl AMPL LP control parameter list mathprogLP-glpk.R rglpkLP Rmetrics Interface for Rglpk LP solver glpkLP Convenience wrapper for Rglpk LP solver glpkLPControl Rglpk LP control parameter list mathprogLP-neos.R rneoslLP Rmetrics Interface for AMPL/NEOS LP solvers neoslLP Convenience wrapper for AMPL/NEOS LP solvers neoslLPControl AMPL/NEOS LP control parameter list mathprogLP-symphony.R rsymphonyLP Rmetrics Interface for SYMPHONY LP solvers symphonyLP Convenience wrapper for SYMPHONY LP solvers symphonyLPControl SYMPHONY LP control parameter list ----------------------------------------------------------------------------------------- mathprogNLP.R .solveNLP.demo Mean-variance portfolio demo example mathprogNLP-ampl.R ramplNLP Rmetrics Interface for AMPL LP solvers amplNLP Convenience wrapper for AMPL LP solvers amplControl AMPL LP control parameter list mathprogNLP-donlp2.R rdonlp2NLP Rmetrics Interface for DONLP2 LP solvers donlp2NLP Convenience wrapper for DONLP2 LP solvers donlp2NLPControl DONLP2 LP control parameter list rdonlp2 Synonyme name for Rdonlp2::donlp2 function mathprogNLP-nlminb2.R rnlminb2NLP Rmetrics Interface for NLMINB2 LP solvers nlminb2NLP Convenience wrapper for NLMINB2 LP solvers nlminb2Control NLMINB2 LP control parameter list rnlminb2 Synonyme name for Rdonlp2::nlminb2 function mathprogNLP-solnp.R rsolnpNLP Rmetrics Interface for SOLNP LP solvers solnpNLP Convenience wrapper for SOLNP LP solvers solnpNLPControl SOLNP LP control parameter list rsolnp Synonyme name for Rsolnp::solnp function ----------------------------------------------------------------------------------------- mathprogQP.R rsolveQP General Interface for QP solvers .solveQP.MV.demo Mean-Variance portfolio demo example mathprogQP-ampl.R ramplQP Rmetrics Interface for AMPL QP solvers amplQP Convenience wrapper for AMPL QP solvers amplQPControl AMPL QP control parameter list mathprogQP-ipop.R ripopQP Rmetrics Interface for LOQO QP solver ipopQP Convenience wrapper for LOQO QP solver ipopQPControl LOQO QP control parameter list ripop Synonyme name for kernlab::ipop function mathprogQP-kestrel.R rkestrelQP Rmetrics Interface for AMPL/KESTREL QP solvers kestrelQP Convenience wrapper for AMPL/KESTREL QP solvers kestrelQPControl KESTREL QP control parameter list mathprogQP-neos.R rneosQP Rmetrics Interface for AMPL/NEOS QP solvers neosQP Convenience wrapper for AMPL/NEOS QP solvers neosQPControl NEOS QP control parameter list mathprogQP-quadprog.R rquadprogQP Rmetrics Interface for QUADPROG QP solvers quadprogQP Convenience wrapper for QUADPROG QP solvers quadprogQPControl QUADPROG QP control parameter list rquadprog Synonyme name for quadprog::solveLP function ---------------------------------------------------------------------------------------- methods-mathprog.R print.solver Solver method methods-plot.R plot.fPORTFOLIO S3 Plot method for 'fPORTFOLIO' objects .fPortfolio.plot1..8 Internal plot functions methods-show.R show.fPORTFOLIO S4 Print method for 'fPPORTFOLIO' objects show.fPFOLIODATA S4 Print method for 'fPFOLIODATA' objects show.fPFOLIOSPEC S4 Print method for 'fPFOLIOSPEC' objects show.fPFOLIOCON S4 Print method for 'fPFOLIOCON' objects methods-summary.R summary.fPORTFOLIO S3 Summary method for 'fPORTFOLIO' objects ----------------------------------------------------------------------------------------- object-getData.R getData Extracts data slot getSeries Extracts assets series data getNAssets Extracts number of assets from data getNames Extracts assets names from data getStatistics Extracts statistics slot getMean Extracs mean from statistics getCov Extracs covariance Sigma from statistics getMu Extracs mu from statistics getSigma Extracs Sigma from statistics getEstimator Extracts estimator from statistics getTailRisk Extracts tailRisk slot object-getPortfolio.R getData Extracts data slot getSeries Extracts assets series data getNAssets Extracts number of assets from data getNames Extracts assets names from data getStatistics Extracts statistics slot getMean Extracs 'mean' from statistics getCov Extracs covariance 'Sigma' from statistics getMu Extracs mu from statistics getSigma Extracs Sigma from statistics getEstimator Extracts estimator from getTailRisk Extracts 'tailRisk' slot getSpec Extracs specification slot getType Extracts type of portfolio getOptimize Extracts what to optimize of portfolio getEstimator Extracts mean-covariance estimator getParams Extracts optional parameter list getAlpha Extracts target VaR-alpha specification getA Extracts quadratic LPM exponent specification getPortfolio Extract portfolio slot getWeights Extracts weights from a portfolio object getTargetReturn Extracts target return from specification getTargetRisk Extracts target riks from specification getRiskFreeRate Extracts risk free rate from specification getNFrontierPoints Extracts number of frontier points getStatus Extracts portfolio status information getOptim Extract optim slot getSolver Extracts solver from specification getObjective Extracts objective getOptions Extracts optimization options getControl Extracts solver control options getTrace Extracts solver's trace flag getConstraints Extracts weight constraints getCovRiskBudgets Extracts covariance risk budgets getTailRiskBudgets Extracts tail risk budgets object-getPortfolioVal.R getPortfolio Extracts portfolio from value object getWeights Extracts weights from value object getCovRiskBudgets Extracts covarisnce risk budgets value getTargetReturn Extracts target return from value object getTargetRisk Extracts target risk from value object getAlpha Extracts CVaR alpha from value object getRiskFreeRate Extracts risk free rate from value object getNFrontierPoints Extracts number of frontier points value getStatus Extracts status from value object object-getSpec.R getModel Extract whole model slot getType Extract portfolio type from specification getOptimize Extract what to optimize from specification getEstimator Extract type of covariance estimator getTailRisk Extract list of tail dependency risk matrixes getParams Extract parameters from specification getAlpha Extracts target VaR-alpha specification getA Extracts quadratic LPM Exponent getPortfolio Extract whole portfolio slot getWeights Extracts weights from a portfolio object getTargetReturn Extracts target return from specification getTargetRisk Extracts target riks from specification getRiskFreeRate Extracts risk free rate from specification getNFrontierPoints Extracts number of frontier points getStatus Extracts portfolio status information getOptim Extract whole optim slot getSolver Extracts solver from specification getObjective Extracs name of objective function getOptions Extracs options getControl Extracs control list parameters getTrace Extracts solver's trace flag getMessages Extract whole messages slot object-getUseMethods.R getA Defines Use Method for A getAlpha Defines Use Method for Alpha getConstraints Defines Use Method for Constraints getControl Defines Use Method for Control getCov Defines Use Method for Cov getCovRiskBudgets Defines Use Method for CovRiskBudgets getData Defines Use Method for Data getEstimator Defines Use Method for Estimator getMean Defines Use Method for Mean getMu Defines Use Method for Mu getNAssets Defines Use Method for NAssets getNames Defines Use Method for Names getNFrontierPoints Defines Use Method for NFrontierPoints getMessages Defines Use Method for Messages getObjective Defines Use Method for Objective getOptim Defines Use Method for Optim getOptimize Defines Use Method for Optimize getOptions Defines Use Method for Options getPortfolio Defines Use Method for Portfolio getParams Defines Use Method for Params getRiskFreeRates Defines Use Method for RiskFreeRates getSeries Defines Use Method for Series getSigma Defines Use Method for Sigma getSolver Defines Use Method for Solver getSpec Defines Use Method for Spec getStatistics Defines Use Method for Statistics getStatus Defines Use Method for Status getTailRisk Defines Use Method for TailRisk getTailRiskBudgets Defines Use Method for TailRiskBudgets getTargetReturn Defines Use Method for TargetReturn getTargetRisk Defines Use Method for TargetRisk getTrace Defines Use Method for Trace getType Defines Use Method for Type getWeights Defines Use Method for Weights object-portfolioCons.R portfolioConstraints Returns an object of class fPFOLIOCON minWConstraints Returns vector with min box constraints maxWConstraints Returns vector with max box constraints eqsumWConstraints Returns list with group equal vec/matrix constraints minsumWConstraints Returns list with group min vec/matrix constraints maxsumWConstraints Returns list with group max vec/matrix constraints minBConstraints Returns vector with min cov risk budget constraints maxBConstraints Returns vector with max cov risk budget constraints minFConstraints Returns vector with min nonlin functions constraints maxFConstraints Returns vector with max nonlin functions constraints nCardConstraints Returns number of Cardinalities minCardConstraints Returns lower bound of Cardinalities maxCardConstraints Returns upper bound of Cardinalities object-portfolioData.R portfolioData Returns an object of class fPFOLIODATA object-portfolioSpec.R portfolioSpec Returns an object of class fPFOLIOSPEC .checkWeights Checks and forces tiny weights to zero .checkSpecVsConstraints Checks if spec and constraints do match .checkTargetReturn Checks if target Return is defined object-setSpec.R setType<- Sets type of portfolio optimization setOptimize<- Sets what to optimze, minRisk or maxRetururn setEstimator<- Sets name of mean-covariance estimator setTailRisk<- Sets tail dependency matrix setParams<- Sets optional model parameters setWeights<- Sets weights vector setTargetReturn<- Sets target return value setTargetRisk<- Sets target return value setRiskFreeRate<- Sets risk-free rate value setNFrontierPoints<- Sets number of frontier points setStatus<- Sets portfolio status information setSolver<- Sets name of desired solver setObjective<- Sets objective function name setTrace<- Sets solver's trace flag ----------------------------------------------------------------------------------------- plot-binning.R assetsHistPairsPlot Displays a bivariate histogram plot plot-boxplot.R assetsBoxPlot Displays a standard box plot assetsBoxPercentilePlot Displays a side-by-side box-percentile plot plot-dateLines.R [ Should go to 'timeSeries package' ? ] annualLines Displays vertical annual lines recessionLines Displays vertical US recession lines recessionPolygons Displays US recession polygons plot.ellipses.R covEllipsesPlot Displays a covariance ellipses plot plot-hist.R assetsHistPlot Displays histograms of a single asset assetsLogDensityPlot Displays pdf plot on logarithmic scale plot-mst.R assetsTreePlot Displays a minimum spanning tree of assets plot-pairs.R assetsPairsPlot Displays pairs of scatterplots of assets assetsCorgramPlot Displays pairwise correlations between assets assetsCorTestPlot Displays and tests pairwise correlations assetsCorImagePlot Displays an image plot of a correlations plot-panels.R .txtPanel Creates a diagonal text panel .minmaxPanel Creates a diagonal minmax text panel .histPanel Creates a diagonal histogram panel .ptsPanel Creates an off-diagonal points panel .piePanel Creates an off-diagonal pie panel .piePtsPanel Creates an off-diagonal pie/points panel .shadePanel Creates an off-diagonal shade panel .ellipsePanel Creates an off-diagonal ellipse panel .cortestPanel Creates an off-diagonal cortest panel .lowessPanel Creates an off-diagonal lowess panel .numberPanel Creates an off-diagonal lowess panel plot-qqplot.R assetsQQNormPlot Displays normal qq-plots of individual assets assetsHistPairsPlot Displays bivariate Histogram Plot plot-risk.R assetsRiskReturnPlot Displays risk-return diagram of assets assetsNIGShapeTrianglePlot Displays NIG Shape Triangle plot-series.R assetsReturnPlot Displays time series of individual assets assetsCumulatedPlot Displays time series of individual assets assetsSeriesPlot Displays time series of individual assets plot-similarity.R assetsDendrogramPlot Displays hierarchical clustering dendrogram assetsCorEigenPlot Displays ratio of the largest two eigenvalues plot-stars.R assetsStarsPlot Displays segment/star diagrams of a multivariate data assetsBasicStatsPlot Displays a segment plot of basic return statistics assetsMomentsPlot Displays a segment plot of distribution moments assetsBoxStatsPlot Displays a segment plot of box plot statistics assetsNIGFitPlot Displays a segment plot NIG parameter estimates plot-vaniniFig.R vaniniFig Creates Vinini's Figure in Portfolio eBook plot-weights.R weightsPlot Plots staggered weights along the frontier weightedReturnsPlot Plots staggered weighted returns covRiskBudgetsPlot Plots covariance risk budgets tailRiskBudgetsPlot Plots copulae tail risk budgets plot-weightsLines.R weightsLinePlot Plots staggered weights weightedReturnsLinePlot Plots staggered weighted returns covRiskBudgetsLinePlot Plots covariance risk budgets NYI tailRiskBudgetsLinePlot Plots copulae tail risk budgets plot-weightsPie.R weightsPie Plots a pie of portfolio weights weightedReturnsPie Plots a pie of weighted means covRiskBudgetsPie Plots a pie of covariance risk budgets tailRiskBudgetsPie Plots a pie of copulae tail risk budgets plot-weightsSlider.R weightsSlider Graphical Weights Slider .counterWeightsSlider ----------------------------------------------------------------------------------------- portfolio-efficientFrontier.R portfolioFrontier Returns the efficient frontier of a portfolio .portfolioFrontier Uses old/alternative Version portfolio-efficientPfolio.R efficientPortfolio Returns a frontier portfolio maxratioPortfolio Returns the max return/risk ratio portfolio tangencyPortfolio Returns the tangency portfolio minriskPortfolio Returns the minimum risk portfolio minvariancePortfolio Returns the minimum variance portfolio maxreturnPortfolio Returns the maximum return portfolio portfolio-feasiblePfolio.R feasiblePortfolio Returns a feasible portfolio portfolio-Rolling.R rollingWindows Returns a list of rolling window frames rollingCmlPortfolio Rolls a CML portfolio rollingTangencyPortfolio Rolls a tangency portfolio rollingMinvariancePortfolio Rolls a minimum risk portfolio rollingPortfolioFrontier Rolls a portfolio frontier ----------------------------------------------------------------------------------------- risk-convexHull.R Data Defines Global Portfolio Data Object portfolioObjective Defines lobal Portfolio Objective Function portfolioReturn Defines lobal Portfolio Return Function portfolioRisk Defines lobal Portfolio Risk Function .convexHull Returns the convex Hull of the feasible set .convexHullDemo Demonstration Function portfolio-covEstimator.R covEstimator Uses sample covariance estimation mveEstimator Uses robust estimation "cov.mve" from [MASS] mcdEstimator Uses robust estimation "cov.mcd" from [MASS] lpmEstimator Returns Lower Partial Moment Estimator slpmEstimator Returns Symmetric Lower Partial Moment Estimator kendallEstimator Returns Kendall's Covariance Estimator spearmanEstimator Returns Spearman's Covariance Estimator covMcdEstimator Requires "covMcd" from [robustbase] covOGKEstimator Requires "covOGK" from [robustbase] shrinkEstimator Requires "cov.shrink" from [corpcor] nnveEstimator Requires "cov.nnve" from [covRobust] .studentEstimator Uses "cov.trob" from [MASS] .baggedEstimator Uses builtin from [corpcor] .donostahEstimator Uses builtin from [robust] .bayesSteinEstimator Borrowed from Alexios Ghalanos .ledoitWolfEstimator Uses builtin from [tawny] .rmtEstimator Uses builtin from [tawny] .mveEstimator2 Uses robust estimation "cov.mve" from [MASS] .mcdEstimator2 Uses robust estimation "cov.mcd" from [MASS] .covMcdEstimator2 Requires "covMcd" from [robustbase] .covOGKEstimator2 Requires "covOGK" from [robustbase] .arwEstimator2 Uses robust estimation ".cov.arw"from [mvoutlier] risk-marginalRisk.R covarRisk Computes covariance portfolio risk mcr Computes marginal contribution to covariance risk mcrBeta Computes beta, the rescaled mcr to covariance risk riskContributions Computes covariance risk contributions riskBudgets Computes covariance risk budgets risk-pfolioMeasures.R covRisk Computes covariance risk as standard deviation varRisk Computes Value at Risk cvarRisk Computes Conditional Value at Risk .covRisk Computes Covariance Risk .varRisk Computes Value at Risk .cvarRisk Computes Conditional Value at Risk .cfgFit Fits bivariate tail dependency parameter lambda .lambdaTailRisk Fits tail lambda for multivariate data risk-stabilityAnalytics.R .parAnalytics Graph frame settings for a desired analytics .emaIndicator Exponential moving average indicator .macdIndicator MACD indicator .drawdownsIndicator Maximum drawdowns indicator .rebalancingStats Rebalancing statistics .turnsAnalytics Retroactive turning point analytics .drawdownsAnalytics Retroactive maximum drawdown analytics .garchAnalytics Retroactive Garch volatility analytics .riskmetricsAnalytics Retroactive Riskmetrics analytics .bcpAnalytics Retroactive Bayesian changepoints analytics .bcpprobAnalytics Retroactive Bayesian changepoints analytics .waveletAnalytics Retroactive Morlet wavelet analytics .pcoutAnalytics Retroactive Principal component outlier analytics risk-tailBudgets.R tailDependenceCoeffs Returns Lower and Upper Tail Dependence Coeff .rgsgnormCopula Generates G-SG-NORM copula random variates .dgsgnormCopula Computes G-SG-NORM copula density .gsgnormCopulaFit Estimates the parameters of the G-SG-NORM copula .cfgTDE Estimates non-parametrically tail dependence .empiricalDependencyFit Estimates tail dependence with empirical marginals .normDependencyFit Estimates tail dependence with normal marginals .nigDependencyFit Estimates tail dependence with NIG marginals .ghtDependencyFit Estimates tail dependence with GHT marginals risk-ternaryMap.R .ternaryMap Plots a ternary risk map .levelplot.ternary Underlying plot function .ternaryMap.demo Demonstration example ----------------------------------------------------------------------------------------- solve-Rampl.R solveRdemoAMPL Demo AMPL solver function for a MV Long Only Portfolio solve-Rdonlp2.R demoModelAMPL Creates AMPL model file for a MV Long Only Portfolio demoDataAMPL Creates AMPL data file for a MV Long Only Portfolio demoRunAMPL Creates AMPL run file for a MV Long Only Portfolio solve-RamplCVaR.R solveRamplCVAR1 Demo AMPL solver function for a CVAR Portfolio solve-Rdonlp2.R solveRdonlp2 Portfolio interface to solver Rdonlp2 .rdonlp2Arguments Returns arguments for solver .rdonlp2 Wrapper to solver function .rdonlp2Control Returns default controls for solver solve-Rglpk.R solveRglpk Portfolio interface to solver Rglpk .rglpkArguments Returns arguments for solver .cvarRglpkArguments Returns CVaR arguments for solver .madRglpkArguments Returns MAD arguments for solver .rglpk Wrapper to solver function .rglpkControl Returns default controls for solver solve-RglpkCVaR.R solveRglpkCVAR Demo GLPK solver function for a CVAR Portfolio solve-Ripop.R solveRipop Portfolio interface to solver Ripop .ripopArguments Returns arguments for solver .ripopControl Returns default controls for solver solve-Rquadprog.R solveRquadprog Portfolio interface to solver Rquadprog .rquadprog Wrapper to solver function .rquadprogArguments Returns arguments for solver .rquadprogControl Returns default controls for solver solve-Rquadprog2.R solveRquadprog2 Portfolio interface to solver Rquadpro .rquadprog2Arguments Returns arguments for solver .rquadprog2CLAControl Returns default controls for solver solve-RquadprogCLA.R solveRquadprogCLA Portfolio interface to solver Rquadprog .rquadprogCLA Wrapper to solver function .rquadprogCLAArguments Returns arguments for solver .rquadprogCLAControl Returns default controls for solver solve-RshortExact.R solveRshortExact Portfolio interface to solver RshortExact .rshortExact Wrapper to solver function .rshortExactArguments Returns arguments for solver .rshortExactControl Returns default controls for solver solve-Rsocp.R solveRsocp Portfolio interface to solver Rsocp .rsocp Wrapper to solver function .rsocpArguments Returns arguments for solver .rsocpControl Returns default controls for solver solve-Rsolnp.R solveRsolnp Portfolio interface to solver Rsolnp .rsolnp Wrapper to solver function .rsolnpArguments Returns arguments for solver .rsolnpControl Returns default controls for solver solve-TwoAssets.R .mvSolveTwoAssets Two Assets LongOnly MV Portfolio .cvarSolveTwoAssets Two Assets LongOnly CVaR Portfolio .madSolveTwoAssets Two Assets LongOnly MAD Portfolio ----------------------------------------------------------------------------------------- utils-amplExec.R .amplExec Executes AMPL run file for a given project .amplExample Optimizes mean variance portfolio example utils-amplExtractors.R .amplObjval Extracts objective function value .amplSolution Extracts solution vector .amplModel Extracts model file information .amplRun Extracts model file information .amplSolver Extracts solver name .amplVersion Extracts version number .amplPresolve Extracts presolve information utils-amplInterface.R amplModelOpen Opens a writes to an AMPL model file amplModelAdd Adds model specs to an existing AMPL model fil amplModelShow Shows the content of an AMPL .mod file amplDataOpen Opens and writes the header to an AMPL data fi amplDataAddValue Adds a numeric value to an AMPL data file amplDataAddVector Adds a numeric vector to an AMPL data file amplDataAddMatrix Adds a numeric matrix to an AMPL data file amplDataSemicolon Adds a semicolon on the end of a data input l amplDataShow Shows the content of an AMPL data file amplRunOpen Opens a run file amplRunAdd Adds run specs to an existing AMPL run file amplRunShow Shows the content of an AMPL run file amplOutShow Shows the content of an AMPL output txt file utils-amplLibrary.R .lpAssign Assigns linear programming model .qpAssign Assigns quadratic programming model utils-exampleData.R .exampleData Portfolio data, spec, and constraints examples utils-methods.R print.solver Prints results returned from solver functions .summary.solver summarizes results from solver functions utils-NLPgeneral.R .*TestNLP NLP test functions from package Rsolnp utils-specs.R ----------------------------------------------------------------------------------------- zzz.Deprecated.R zzz.R ----------------------------------------------------------------------------------------- fPortfolio/inst/LICENSE_GLPK0000644000175100001440000000300512323217772015216 0ustar hornikusers Olga K. gewidmet GLPK (GNU Linear Programming Kit) Version 4.42 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Andrew Makhorin, Department for Applied Informatics, Moscow Aviation Institute, Moscow, Russia. All rights reserved. E-mail: . GLPK is part of the GNU Project released under the aegis of GNU. GLPK is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. See the file COPYING for the GNU General Public License. See the file INSTALL for compilation and installation instructions. The GLPK package is a set of routines written in ANSI C and organized in the form of a callable library. This package is intended for solving large-scale linear programming (LP), mixed integer linear programming (MIP), and other related problems. The GLPK package includes the following main components: * implementation of the simplex method; * implementation of the exact simplex method based on bignum (rational) arithmetic; * implementation of the primal-dual interior-point method; * implementation of the branch-and-cut method; * application program interface (API); * GNU MathProg modeling language (a subset of AMPL); * GLPSOL, a stand-alone LP/MIP solver. See GLPK webpage . Please report bugs to . fPortfolio/inst/LICENSE_DONLP20000644000175100001440000001343512323217772015427 0ustar hornikusers ******************************************************************************** * * * cosmo - Constrained search for motifs in DNA sequences * * Authors: Oliver Bembom, Fabian Gallusser, and Sandrine Dudoit * * * * Conditions of use: * * * * 1. cosmo is under the exclusive copyright of Oliver Bembom, * * (bembom@berkeley.edu), the Regents of the University of California, * * and Peter Spellucci (spellucci@mathematik.tu-darmstadt.de). * * * * 2. Permission to use, copy, modify, and distribute any part of this * * software for research purposes, without fee and without a written * * agreement, is hereby granted, provided that this license appears in * * all copies. Commercial uses require permission and licensing from * * Oliver Bembom, the Regents of the University of California, and * * Peter Spellucci. * * * * 3. If you use this software in your research, please cite * * * * O. Bembom, S. Keles, M.J. van der Laan (2007). Supervised Detection * * of Conserved Motifs in DNA Sequences with cosmo. Statistical * * Applications in Genetics and Molecular Biology: Vol. 6 : Iss. 1, * * Article 8. http://www.bepress.com/sagmb/vol6/iss1/art8. * * * * cosmo makes use of the donlp2() function by Peter Spellucci. * * The use of donlp2() must be acknowledged in any publication which * * contains results obtained with cosmo or parts of it. Citation of the * * author's name and netlib-source is suitable. * * * * 4. In no event shall the authors be liable to any party for direct, in- * * direct, special, incidental, or consequential damages, including lost * * profits, arising out of the use of this software, even if the authors * * have been advised of the possibility of such damage. * * * * 5. cosmo is provided on an 'as is' basis, and the authors have no obli- * * gations to provide maintenance, support, updates, enhancements, or * * modifications. The authors make no representations and extends no * * warranties of any kind, either expressed or implied, including, but * * not limited to, the implied warranties of merchantability or fitness * * for a particular purpose, or that the use of the material will not * * infringe any patent, trademark or other rights. * * * * * ******************************************************************************** ******************************************************************************** * * * puma - Propagating Uncertainty in Microarray Analysis * * Authors: Richard D. Pearson, Xuejun Liu, Magnus Rattray, * * Marta Milo, Neil D. Lawrence, Guido Sanguinetti * * * * puma uses donlp which has the following conditions of use: * * * * 1. donlp2 is under the exclusive copyright of P. Spellucci * * (e-mail:spellucci@mathematik.tu-darmstadt.de) * * "donlp2" is a reserved name * * 2. donlp2 and its constituent parts come with no warranty, whether ex- * * pressed or implied, that it is free of errors or suitable for any * * specific purpose. * * It must not be used to solve any problem, whose incorrect solution * * could result in injury to a person , institution or property. * * It is at the users own risk to use donlp2 or parts of it and the * * author disclaims all liability for such use. * * 3. donlp2 is distributed "as is". In particular, no maintenance, support * * or trouble-shooting or subsequent upgrade is implied. * * 4. The use of donlp2 must be acknowledged, in any publication which * * contains * * results obtained with it or parts of it. Citation of the authors name * * and netlib-source is suitable. * * 5. The free use of donlp2 and parts of it is restricted for research * * purposes * * commercial uses require permission and licensing from P. Spellucci. * ********************************************************************************