fPortfolio/0000755000176200001440000000000014421703056012377 5ustar liggesusersfPortfolio/NAMESPACE0000644000176200001440000001210314254636366013630 0ustar liggesusers################################################################################ ## 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/ChangeLog0000644000176200001440000003154514421040451014152 0ustar liggesusers ChangeLog Package fPortfolio 2023-04-22 theussl * Removed donlp2 solver and the bestDiversification() function (for the time being). * Integrated the Rnlminb2 solver directly into fPortfolio * Changed socp solver to the one in parma package. It is (almost) the same code but the package is hosted on CRAN hence facilitates R CMD check on CRAN. 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/0000755000176200001440000000000014421312377013312 5ustar liggesusersfPortfolio/data/ECON85.csv.gz0000644000176200001440000003000414421312377015344 0ustar liggesusers]ˎK\7 -*@je_&'#,wnf_߿?{?????~j5:};Ϝߦ{oߺOnYUo?ͿJ59?gw'p{?g!gYCk^RJ{v*>j^bZ M.6v`_} m;OB_GA뇗GYvoh^`6U5jz^wpO5Nvv ou:-4a[ ][gc|:{A:wЁ-,-I&jUpkNlYjW%Gb6pɌ>1czVU,g=˔@wXCb{|uJXɶv9S&g'ϦO"; |Vb`c26S>g}Oaq]63q]jc[qwVc =7{pu7]gcpM2ܠ7t bslZns/}vcOsֿ[; G'XY:|}E@gjf eܭбԟy\(ޏ1;U2j rg#d,rЊ̓ ΰL\q7"`ݷھvF5m1ao`mpЗLdgkTXꮇ;{dn=Avl1:]SG  ڥ`W`EN˕ŰͽZ~=e`nrOmf6|bJu?ۀY{iBF;{AA|/~o64NTtKu%O %G\ Zl W O~w6\SV>0>.aݚeƙt\xiο Tv[)fڏX.ʭr+[Dr٫ϱ7l]õihoc+Q\T@!`!ga㰁=V.H 6C`ko=)r)yvICg'O;8HͦcV: 5}ӔE/XxASw9əαY`{;p@mLb*Mkk``/[v}]?t8#L#!q?cBgQo8@섾kyLs΄1P\;rI#d' ;:3Lm׊ a~E:$@~dWklM ;n|J{v/UQg`|ݩFH%GfMWW~3^rxx,x^p`VR"i*A,Wa k>9;% Ӕ xV& ֮^b>ǽxwWDepZѾʊѩ_d.Lb'3 S̃&yv<)TDYzEuһEH W{2 ~wUiW&n/|vOv3\7IUwޝ]W:;f>ܖpg ]y(ވ͢mj'lY;C%'_ث3| qN[=._\uv}Q1-`87P 5PiG?Dx@]5AN/ {&ֻ}Xi2,Q|ώ#`Wz#g"f]/bh#JN*$+(Ä+۠*8^[vM:w~:Dc ⾐d)NLnc|2EFwB<ܬ] +?N/NۥUM΄ su9*ng_'β9u \DξvmgLJ*؆`Ű ߡwh&KO"e1p-á+G~|lrSÏY~y. \Үa$P&}Zv@'qlW7]-"E"^jb @lV\'gEH&ڟ/SWթe}6w:$D]z[KpǸJq 3:QvQ*u+Ow03&y)~)BX+FVvE.5ֵdu;^5=B]oB8) PhT %8Iz ËzS)goSlG{J~)b$3r^ju@ 4Ļ W /Tȏ`h!֯oPSzq+I^(iB%&@\\Y*i'xbY#F^2ݱ~>0Wn# -(66o(&ۨhVdŘ!de`:}QnleoFKD#K1J~o7慺)`ԧLi.#{t0C8.-d_Vסd!.r?NO. ]{݇+J I2>Dw4f6>b\/=91 o 렂%/_\M#ʠB.f؁ߚr :ivEQ6Fw05.kxն@āFϔCi7jfQsST ALR*w#^Qԡ7ü1aqHH:lؐ!#&rwg: +^ p+=$R­l`p<`1L\v.DJ% ׸ۓg)u-~T)2uNNVhi3VNOoi,W޿%-T{PAyP~ce>ȉUʬ l{}}Nj Zq+:*e1]rXr}QK3*n~ &Τ[Gmd k)B b|dqPcXB%'vR_H޸pSh`>ȝިqfqWjC9]NP" #zU}Lpt ]RFZd~7RH38\.n-]jet$D'\O* ">_T= `v]NX<Yvc9mI`._M$fǑ`K t(cX0LF79v`+kʈ}gE";ά(*Bif#Y OP8n:9[?Ec%rU6B潆 ӥK=NSk=qmF*P_Jo5;Nvדg| J!:i.4f'sK{hzM'Ԏb^P';#aFDr#ETgoѡ5ߚ!$:khJ EVs)=!붇:2P"޼#AɝbW|ZMarpw{=m)buua+:&b~(. $1Zr2^+K(joIo+8zy ,͕i/ 3BJUѵ/:rMg\(H]`]|? /ϩf]Xe(\:mΉ~ dStO&];|"itZbTcye}6up\]m9ܓD;ʂIxa&ݚ5h8g֭0kI v^WƠ 1w or4:=GY~Wk0iEk$Aܟ*o-Q'lT}\ӮeIu +3ԛe?4u39:P .[D%ߢcO5[) @uAT=3`,o7Wl$x;кYd:$5ŬgOlw+uʖ#fRl,\~éQGZhk&#h=.n{mOm/ȰH6Aqvkﱿsmn'W#gwyH4[9^FT7t$`'9zU֩B1>RBDЉ\+ץXjTB-E24IZ$*^f{)}Cz"6G[+9CRGWK u햫?&]}A\Јtt >Є-D1UVCv΢C$uə,z8KSMaK 1 z"QnǞeCu5WnUיִ^.J b|Ў=5 cɇ=kj=˂w %&2FD};(W`{˲Cvw`/զ᎓br.QddT#IeG-W$3yOantoO%Ȍ!)|Ў>܉3YXСޏDwre|L)FsTfOenfs&㔒Iuh.t>)Z@8N۝Vqiȇ;k`kya4jJ^?hHǴc'k9=NoV(s@ېnzJ<}Dd>T9Ι+FB?lѝ@qXG}O 2iϴ#]pqB#th3hk`2&".@yJAIWVYIZ6FODS^;_& 6QܞbybnYJARtʯ곛S;L8.{=b>leA4|p{c:r1..u$ tM<Cڐ"20ig`|X$j.-KN#)QnC Tm-z~ \Zn:M7h7:vD䩛*,#>\׊@Qwڌyg S,SW9dYiC;1RPU(8uOKSpVW0Q^yY /#ڇXZDLq4krJy.g@-=Ne4 E]vcEq}{ 擿Srr\*mΔvSӺZl?$mqy<̲94jé Mz5ZlhX㊢zYlharۢ,RوDg*漜 ՄzjOJK\A2H~m QJi}?N\Fo%~>qF?<3[l'QB1֫VG r$3 luSqRmC4 }5D o;H_Ԍ˥w}:0vDD@O;Uisz!]ΦnXpR׵F-m2)'vw H}A"rf .4T>FrmwX` Mhai-;#jԈeOzѓWcW \`Sh1u%~<عeAàMg(ajbn;hVx#*K''y2ܝty|<;W*xm&Q|e2,m4-DЮBbCr Vʧº1ԑαD؎ lt 1Sґsz:ݲ%&MIdnK U=p6>-n<@{f;-PHRʰ aϨ:ˊyOq.+6 _7W5@B8K{36LF.moa^@Zlۓa"wo6LuVdžc(% }kgs:t"D 'S=s N ݞ5Yua6LbCaRQ2>Eg"sX #GoK?omr#4}QwqZIX!g#v!9Q*6ߚ IHg. qJE֒l?}DDMl%Ms'r}=o4m9 駇V,58nI,74tx'Ʒ㋾(=􀵸=u^ nWa˩-aϛ5˾< ̒CiFsrَ}< zT LyTטRkCھPu0:.}cJ32=O cmE0;ߢ-$LAk{qW#y-@88;h<<ƧQr9D|A"r]&o<\t*0EcA\x" 4Ul Ql[%4Az"@5D$9LjuXpY@YDᤡs +F>:QUS$B sz|w/ fEb(xXoetSe<{LrO^|-F-0F ygy+Ӓ&a}ս atWmzs˓KO6 {8q@ZoƾA(잼kn5ɿ{B;I3"O=P)9hKd?2n-MMPX~Lm64b&RՉ9i Go|hNؒ=3) dzQIݓ66.hONuo;Gy럞 vZ2ֆ[kՠD`7-E,xbg = ^6:q;eXeOشXĉwo˺޾LAL׶)J͢B+513l NE2:~'JV%eٽ6]BeԔѐ[1it&jۑ%8OTV@sz ;Rp)RȆmNT;SXM5k<(cv~/< =*n LX<.uV2dÁw}_L|HҴTW-/O>yAԿ:)h lI{fuH~3?6%lrlpn_-S7 ίt#k5vUcytsEOg|0˦+$ +v-^vnRiH(yO:ٸ(f6?X˷d/%PFϴkTį~rϊ$4Co| dȷD;2e!zD3} W ~0y;t|w`$-~1 E׸Towi.JcEj s%]s]~gͲnx%WHWbdOZ]VdkhpQ^f!؜&[ˬLcDn4f%uK{I=ӱxۿoݘt3"r5K12] jTK ĥ^w릔@94`sctn{Rͪ\. dJ; Ϭr[**jS|̇e at{0}s4es+Hm諿Y[d])(9sB=-Rw5޴:Yuä&@p5TOл{BJ~r+$VTd(L!}tSxzq fSV͘pgX;ԐfH?O)=]y &gj]+ͽRZ40QҲՈf:ϊZT9;[tn֖"nޤ-i\[KEmJL7w!50ϼġbsr|F?@b|6:LIp}71}Z`+NDS@7$ sAx?Ӟ:y<b љޗ28Rz⽦D)3e?aϔ =͌,W(9sW?;+pk3*StFiG6' eپ+\qm/=z7Q7;3jp%OQto]X\$1_$2'S3;]];?y+rRe<4Sї:|g?OsyR"7զ^v)BhZm+ N%N,HuIQ4xdn+4ìl'02醘o㼋œC;O{%iu[cÝWt`fꇛ24bI͖زv'ǿ3aůMaԘM~iSɎxzh W²SM ;eVgyoMσv #OzGFklۯE?ʲpY~a"⯾s?=753ZuWnsb24Jy>o}Z{/ R׮7JP=KE,~x23 79>,gqȣ4;*)ZY{vDYopVtm֌5Vybw^yҿ1 < oCB#s?]\ Eb~7z1p8<yH'ƻ|=~XV"L?ղv64M5K^jQG=8s*[f'7k7'C]p@x,oHllVZ<Ssi0Gu-{KgFEU"ƜMlTޝnr?f,{o+rR^+yG{B:}1ڽ|9맔]ri14iAW.4 4bb|J4{kfPortfolio/data/SMALLCAP.RET.rda0000644000176200001440000002364514254636366015654 0ustar liggesusersz[OghŊIQl6  *M*$)""5wLz"$ذA9&pOXig]Jxe\cJWI ߃+?C$eAk1(+)ƺGS NEp_| nj=2W kmΏ rx@s$gނ{w*/ ]s"'dDsOKt?|,Z 8 ~?U9(c&4Hł=DY⵼ $bŠa (R \ Ul*cuo_r)~)%@vKӕн2}N0[%.I"{j' 䅻F!cȟݐFow$Qb҇#F5#*x Q^#Z%q4QlЗp ˒[=Tv20Ӹ.\g9@fJUIXy"|t`GXI>rSx RjEԣwwQ,5`*u0s7U;u1jׇ|˩1䉿{20*%:ٌ^Diۼ(v/`po3/I(p[*hz:-Pp8Pzc-Yc8M&`@V04fK%I)%*hCg2}2PK^O4$?| _h3m~97}1;*ZA\g!s`e2<W`yf D.=JϺmng>C`[joH|\G.hM}wn w'.! bYavOf&/ RR$UkQN9A] 5/+CJ(2n3W AOhXmM3%Bܻ,VtCeR;lZ"N ;ɊJ saT cDwa0-HdhWz,z3C|渧$;.ͧۧ/lx,d9PM琋4C؂,2Zc rU16} ䷓J|cG?,,X]dY[E+Ħ,Io?! xp^I=?g6h$T!Q%h>8LRQt~u'4Z~eXlxK cBn_nCnd&&ḻ QP_5FjBF>xS,Q!|(Y}Q#0:-0_J*b2 gx{͎^ 3KwA@?pmө+۴A!c6Va6 yw|ƌj9&Y6*=0_2I -EK:X;NǶ7GE°/Q]^>=T9Yb+}|X>g'@y !{@8ՑĞqDŽŹQ>~xE?L7'K̩ͨDUz c͒W%sq-V"78Q( ms91 e|*AR'(D>2 hZYCpz5a g>=쯽o07S <R=}H"T8.)_|:<#IT:e' 0׭?BR/琭XB|2S-)_S1q9jJqWS~]q5`KfNkZ"̭&xj7R_܌P`hlzx 2/"X9ⴗ<+>2;Lxh{g<~~.,"t'`BLW/=ɡag10U> h8M &3CI FzhVNiQq5hA Gag4 < ?6bNV\Za*z-<~jǗ;W鯇pD,W*幐i$?{'lCYpΰ!)ªlyKcw"H)tVCl vaU4?h9v\2wqS#9Il^}i08f%&izrCPɱӰ K Zjaw6>(~ܛfe|rІc@s6ʧИ6kCB&(pDL'b{ uQ| h(Ea1lqvXA3Y"t"ςqܤO3PZيZ)įXBN7qA*Μk]1_,OUOYK_?ZyrWr :of~_X˃Q2ٝt*VL  QqvFS@)CpƭC=`/X-ɮ~?# 'aFX&~dTI9D{;FA`7.[aL+|}XBVp/ 8(kgƁ_PR~X !IIQE3d޺ݮv_@?oR%EkF) 1ȗ,._$*5C=곞'Og5G7[VyK }Xn VXr͟|'KtpZj;q".]WC!Y {|+zJoWX+z2>!ƌ{50R/IU/c2+#og< n|@7-7RA|2>uЖ%0A0+΢->oEu`bzxo屫 m%-S\M\٪)|ڪ2JMo![֝25iR͋XFrFsr䍾9BNmʎ)ViA-b>C_ҦzZU_5|hpU:v9aљZP(2]lQ̽{(/c͓}y5O)"Tˁ˶m&c!pu^ܜ?_fS7 {]d4ݓ!kFq j#CXV2> %kNp!9Vlwb6D䪂♆@8-3dX>'iÉMH2/5ȶ3RBcSuO(K6 ,,*0\QroS_aU^ d\q" P׿%wEΊ#së ޑ гq64rx7T`OJ$T*ߐ "uw*霱ykh |`iB%BR87[5qTPdUz֜X]Eœ8T~5u7?>Ok: yx{?Aa,wQ7~Cs uEE`ܳld.8nsTKNDX&{h n;y%B ˧9eu*`e8eRo$TWpn*#xE}ҔQt#T1Oc ӡp-Fu[zq|4< r0:U@Tqm U;2Zg2.|>"{ũa~M;GK#7?i'Go ČsY B?iqoL[u|Dc?&ݞ=!ꛆ40Pk"mQrӭɼ LOӦAȫD/S•&7?T:ܸٝy#*z7}|?-䥘(0y O;1{H r0!{k'³Ix5~>%&vw>"XpQzbBRk+;ĬU|?X&qfmXwQȫHVH\ƵK8hcYбZZc?)KNx&t=wR_+u(㗫rhl'QNZ cR0NkSo{o4mtZazLS^+l"!ug U0wbzld3yuHjEҟ &5|bh]cHiݓt ǐę66~Ux97fg:cDESH_+ȽQOy/~ [֥sM .C_-(aCNurcR={,ʄ˜w֘~w2e-Cs@9wg Ub{bOrz|{LrY:^/Z1pT dLU?EC5[wHw~ S4ƞ,,aK(r|7G>j+\.dGΌxrsmq>Vc\хH}[ڿC+wdo@"W!+*F%:oԜB.F^={\+ `+]a2c:ѳ[~^3?Cf9VTdD?^{,M#, 4 kX |M %_h^~,yQ\ R!Gё/GsBۧ2 ?lFꏇT1ח+A9.D}r <1&Q_>Z)e?K܌~?B5VH5 BMض'Wݲ*;*łhw.|y SUzf?b㌵~0#ckƲǾYˮGGOz{*RF㣭 ;Jؘ<_B(gHFWȞG;_w:4!s'\`-&Ѝ]Ƀ`shIto< 6e)B";np Ou3w[ Gڢ`IO|/SPbd5Ekf:ݯ{Kѕ`䰩1|n*@l^u5}apinkx ֊Jk@Á60u")1VjVr̶Hl)I&`cCBχ`3Ϸ`هZl1D ml6CNl**l|a.ݙ`& =@G\\U6MtIvpv,."oÒ"!\`n-o] NZkb]kȲ߼ v+KRۃ7oKl\!x700,.0`_P`6 ~IsH#dм[pjNc)dbf5N @6]Oi].YڍvH#{p^~YHwɢD]Z'Nv>c;AXS =dQl{wLr91C&zzڣ79 }wԝX>)z'Ecqhfosn}f2Ys5?YsGGT4KViǷBkxt/<__;ou[ģ^{Q;?5^5v~Ƿ7WKv-$9o/p_ikr.7?H9RWR=ж%9%IU n9&u?{&"I#..FmN?RHe>2_yy+/nnV/IBK0*Ē(1SI ƒ\6't9%ytzrb#xi~͵~[4Wܴ7v罎S";+qKNcNV6mB\\qUr}=y#ְ?3V6 {)'(ׇgcRh<ا,wO3s\6mIg8>ؠ|"<(r6i=l:ߗlr~vTqOCFӕI ڒ)fc=:[~+̵M+ː߉\\Did56Iɒv*UbG "x94Gɞ&Rk}Z[S4;]VGk0h/*cokIr퓯>vI2='|*e\Eђ$˗M<L%O?!5d!9r<#YiE%iRrٹ% %ce[|JһDbb60K!iSt֥گ!O T]"]o:P-ɱI5IAB'()>8JIF~ST{ֶ7 V-%YW#}'G'֐klDJ#@["plR|B:"v!GI{OCjr5$r2E|c%sI0TrîG?sAMԇEy%w]mZ楙F'|bc?w)y)ȥ:ttKqMΨEYy *5ɕ!jY~N',?⑈r2m8>7AgG'BtG nJ KzԼk=šQX\=iӗf.*`Z|Nu '%=DpzM7ҡd*Ok=Z2lI2'<3QI0N#{%ʶ]%uR:i8SSKIHEO& ([G;#,Q2sE?|(v=5hXȔ9,A䐭ڍI+xȱ&:[vV܈=?K yމ":}I|+%zʭ(.ߴFcxSA \l{?\6+ ;u(iI”sR+?A %W*7vM={Lwi t<(:ٚpVRN@Fj&t.*zr;7%QC8{40ӨbYnbq2K:K"ֵSfƑIY@ BcAMX@wũBK "JޘbK/C̃ aS5|f9L߇9~tѕ/R%#7FK73(ZJߕ1v9(N/ Fd)Qc 2*!dqR=OLu2nŒ<<=6}S0:^. Dn581) ,Y.e8Q~L:^ 2QrQ9ՎYύROn*nNr[M6Mv'ݳT[)Yr&8IE 1l'e!v)/Omʂi*e-XQF81I Y,~_DHl%]ȠA&́rM-z+W1%ipEY*[o'hd%lBK5,{G:xܢ!#٣5~TAn,Imy$d#4~m#I#4¥i uE*ć`KM;-:;G [bKJ g; )#tPK j~18Ӣn|VF/Wa;/7ќw>GRY,e}*mI&J;Nk3:ICU9J4,2jY1eꗚ%QŞWAv%'"C|˔Mzːp~vGhjl'Ƀᰲ՟~͞$/iIO&8VbʖCR[B-F⥩d(| $) $tũásWtYOr@ 2?^O$XDs_s{dJ"餆>UMMЦu)L戠_Α$tjd󫞤bMUx'~GS]Lc*oe>vSحH=P} J~ׯ?%ɴaԢp'o@ 5+;GP?.<(Ie 7-}ZOg|yU)A&ECQH:WE^Ͽ}8$/Q t;(k1֜"As-zIbCDKdyTp::*CPJ!"yeQ%ɼ[r|zbuk&|Ҭ9ϯy0QUuM=M&/N8HqSf,Or;WUV "//AT񰾹(`9\Cs$M 2m[V(>QnLIk+~*HcYM\j.q.קnF:\ERh]zAMwY$yN_SjEm$)~_Lq]|yɦ*_dE-3+°[ 4]uUgry}:'oЫW<4F GIK2 aO8%sz! d+AT PgӃ:|I5v~2EBPKU X0*xdgZ˫1O.$b blhIҪdB(tPA%߿ 'lIkk]dXʺkB(n!Bb.=(G} c;/m HWw\G{T Wf DSduA ApC΂uCʅqA} $Dzi1WxubpsY$X+ݸB-( XB#GS,"!  խ߱JK0ڠxA `O_t&]y {.S B-d4epRuuQU.oӾt@ZM9$nIX!Clv$> +\L*p]J6^2f7Q* ,~>wf%%&:X@K-:=f;ًCHv7eMv"J)cIrJyX'[\!W]@"zSbqi$ihE23%yƿGh(^;Q +^tJ+KXIRkQ\r_g|]E=?C#!$SvPyd-I Ѩ 9 A5\_qI݂ l2)A &ӓM93-!S(hf% JxCKDk2 :KzhK/Ӛ=-jhwH SLdԓ%I|N Ֆdk>d:R1CgoBKLn1dhU*LSHSmkjS'Q`藪I:< 'zn5ȈDU˱o[Īc)RK_rxSY y[%!r,T#TV蓩iNn-HZU?$ҔyT .|[? e%|IbOG Iz,[aFA{ Iʗvkq C 2THo$}JbhJn6SZHɱz| ؇$y=IU݃|׉ƅtD9է6YZVG6Je'2e -YjeOSXUS|$0z,&[AQ|xc}tߟ(_wv(㫣nD+wJ 3\(Ml @Fq6CW[B1FͥGQ\BO$P4RfNh3ئIȆ&ck{3ʥVP 2 <un."#X`q<ߚqcȰ'Pse}r%/Lcv` '.|_e޹d3pg8KɜC< Nem$ ?CKWhmh48$h dhOkס.ۈWndx%:Ws+r$d[eDB3RӶvYpEOos,Qn(cbE6."Y΅, 0MzAZGgz,&:o~me;?W(Ibkzw9 5a&4- .Kevmd݃lWc(W4Oi7=bujЬ P+D># M,e傫Ƈȝ1lʜ{@ w%-KFdQr[^qƴVOkyGLWo'}Φ"m1dv :/o JI,iK:Y4NhUPa,L( fxG`,"F#V5 )ֵND'ci) uLIja表}GKidQ{O4ɋ4ϡ>tw6ovQ34 _ >@TR˗DsTN襂<d#]XC&3Uh`^*b<[?u B0 JwF\趆LR)Ь)%`pԟoQH \&Ss֘)AbRDAq~$qoߪtW nLR*%YȟeR Q; +ݡU70VG0Rm0v|| .PE+jbzёnШ܁-K羻)8vS{nM%Mܾ')wn&# [:u()AKj?6E@/Q싨4kO,fQ[ .ϬTa(׆0V7miBH2jyK{;bj23$ʣ0՞Gܼ&!Ou*05uCi^9e2sre肌bW `)~3C5Tt рUV;6ImOfPp Ӣ BZ.`s8(f}ԝnѧ}zv:f[B ͮf΢k|HK;I,L;KJ@?}QU63X $X(p{f0@qS3'j # S\[%TYؐn5i[ &#ۜ%0 32:qj9!٠s"=atH \5]ƖdIkB7Ȣ@ PE\}= '[(NP~W[=%|3n*YkN qyIJNj}κ}bz>2ռ꘏^x1L<)i/Փ,T?=(Ȏ 6ӹk<aڏ؝auo513 PJpFR<[ʳ-$X 7" J圎$TTi~*KgJ> @8!e\mdr! iE|-ٓ&qoq/q\{44}2P< gYr *=j4ax nb,M*>`i`$Y-xJw۟!G~A N*Cr%eǙk K8Md PcwX:{UW& @9(z7*Df^S +g&J_4R&XA&7w7LT`f, uz'(IQ wMsx1#uSDz YFIF״[gA7an9>vA_38ῃs]Pey: !k7Ke'_BX=az D'(G<_S֒$s1zDV٩F3:I #X8wIe~T~z@EOE%!( "nbiвkT/{&`u Qo0a;:Q5oPiO8잪3bNwÉϬ)X=ׇl֩'%X4' 14ݹd!d/cJ@} z HPԱ>{t>kЯ'⬬#X #g| ۱~/uB+S5EveB,ѱC3uCw޽鐗4׋q>U-bXCP9KA9S%q(=Ht=n 㺣Ա}'Yk@H$MSS8AJk;"96}TA]Ywd`Fs[վ#&fZoL/ic4;)ޣ*!iKL_܂## m149) +eC~)N¤GãZ<AgIs NMS;JɴU=*TcN !U4Bc5z󮌐 àwLsrM: j{cJ/<:⽫0 "%35}:%EgJn:hUL"4'KC萇 sq%inT A,2-VM) 9>-`fQ :> ydV?q&U4cH ᶻ<8ufk+}1yT'Kv48 5.t:NMϙ3?ä[8ܻ5CAQ0ceVcm3i*XNILjn3J.d.d1q#!52nt1{CwGO1|L!L[Sܒ1wUf&s4=9)zr 8Gca%a=T ;<:ڈgkVU$n(Vi[ii熸;L#Nv%PV%5i>TTXCzy,DyTFTN/o5ݒm-_i(4m q6o7xnt CͷVPe`dcʌ p'x{fZ5YrHH+Wzܕ {6P.hROD$әQBB}K ٮC4˫s b4W*y8.I#"}f `8?8[$yW$> l$&)P끅W2k8Ѐ>sWхe5SJ\0P, _189Pi&=$Tis7@\h fύio.aTؐ >^ z-Zn0!(Hv)/UʲG`X܍tM!%ev !M߉B9[k'85ix$|2(]HHYL8`Z Bc7BgyrogBw$B?DfC'*بYTmJh;JEYR#<2` @yˠ0wQh^Sp0.mյpCq'|NlY[{$icڐK#e҈#qP 1Ã!́IxoQ]9t^!_nUĪqrn ]m! fӱCs8.sMUI$Y4f{8PXDe)ZSЉ>^©SpA[T=q!qnn}sɓmȚ5Jh̢~<;2}n/<&CGO3 {ncf]wI&0(@/E*ϩx\?x|QOIT*1?oS͔SBCڈW~a9dFPW54$gYtΣ қ?inI4] E!6nCHfX5'qCᱼ?a^J}H%2,!aж\F:ȘFɕdg\KCwQT=N4IGuB"F 0CK(';4ه+o⚐u iF2&S(\,Џd͞ 7dPQeZm`U 9V|k\?'̎=ꌗz@&TV\^sZyy}W@GV"4!_W`VЊ\wAD̸U-#΄qF&>PU&3?+jxJ)-xU-FU[W.|,%JiTK!c!̼rybjS`X뉆)q,KfE-EQ6W3:[K10/*(YMkŁ4,MsaAe53gkuDgO k .i^r# ۔eyԑ{9tCCXi43T32 z]C1л1\=j |ZrD5j "9&pDS8c+d\%<;3˦ ] КOz䥞CFBx8?D3-gfnU/q䩶9k͉̙}aGD7e9W^04?%΅u+`Un_HG8]\g8|#oa=*+CoˬgI):3>pO ',569>OaXN{y$}Āx8496+چkH̍[xV0]pٌ]KCl2dY"f8?őI3%Wd\期-" 8]PFO8{H%_/tU&R{JH`Q̭$RWe]MIS2>ӛtMbb!YX} \ )Y&wo9v*Cw\.iSn0'88< ۉMWm_Xao#T4 h?ѽ+I󺋵M~qJ*au]aε,qԧ#Y8M, Vy14'.3p)z\Pqwsn]?9h+@3Es6Vll4PY[~?@Bq9-#JRF@2RJ OPvĕ[!4{ѯ;y ;,-xM~I'`.Ң~mj7& 3ouT~"w;=6|*0$Z"Kq"d x2Pze˥*8(0倮@Z7aB }=wpCpc@4W[NLrso`v &20Bƒc" |kSx>(qQjT/!M D%8@q/|VbM~ުF"&0hz[%8-yŠ,~A#BK~TLjZQ~ ӕPY`:cuDTgyju즖ݘ6Y-tY隸w1n ?k:p`#U8@MpKmdtEc*wjV 4OSFo幸7тO\jvև\ΧOָum6޷VG!#O(tܯqaWՔ n+w77fB2_ c`5UZU% 6p $ť A= yR =2Ssη06d|eDAw$"rGѰК dheE5ZiD@R{[= Lj̢GqjBTeH_W@Dt ])jWQ|%G? JpQׅ~9'> ݸFCq̀DL0h7tK>̣T<38UdyS'H m)wD}zʁSbSڒAj˷4ȑʭ5 e?W>Ѐqb>U0%4a氡&RS`7K2f>Yre]VeLݶl]x'9&p@,r<.QE7!1uL :*U2+|{r"5]^te2Xs|!r߷1?aW|o$J,!N/iKݡ.7Cu|qcp%=9q25vȱIuXX0H0\h^\E%5f6ݾIAu#F1‰HM<17ņRv=̍i9T'[om¸+~^9B&%ap (G{`簶^<8?ޭixySX(qt`G?to0;+z9`~(πVm-FL +~[-p++u9 =AjP4`s1AdQQͺLM1:vX[Fx˵OP6Lgu1\ӱ5&Y[DZ\w 8v##Kvcъ(4xk[(Kv}0TV$y f婫APCᚡi{j'f8m!" L4xj:&KsjL^NCm@ "L.s41R%Uo>Y{f@F(,¶8巛 ^J'&G@ONr9t̎wey?_&Ulk[%N]T≲6mVo$Ɋ4ĠkW&|ȗt^/  څGMB%CCφ u̖[3tfe?Ŧv2G\qL8TQɖ A&GF.dSu.H'da?u?Ǥa"K3#; @_W7>r?6^\_VT^] 'աiw~Q  BDfx. 0[]^S<-G( K1h-?dkP3EwQ9}42UnJu;D>˜!,h.,䠡Qa% L\fYؠ +hF dOo+΁bK5ّ+v'wF! mk6ewn/\Uջ?L ^?GWƧD׼GCSDpОe_ $P3=fC0sn}l ?qR ~@Z)kD+p/nmfNdwu qfATju-̦$7ǕhE_.4 wxBjOi([iz]ɷY gʩlZ.T4qM3[\7E<`G+ v$uzz/]1߅ٗ<+yZmkzHNgpJW=6`J6?Kߢht셦Kgq^]Y)E]@mx젓f> 9mH3g(YQ2-wEhjGk7ABNa_[~f.n6ZT˃ݖǞra{yzU!b4Y$|N-j 0 C >aB94x?߆d-]HŕMY*H$" 5XWJ,ՁLޘoVb0 q+?݄tgsU ;mjctӕ6wW1cw},mt3'DT*\cf3V]ڭf:;P ȃkF7\Apj5O LPnB/q[-8ua*]X R?O"*6j'EJS=}%^F^,w^$97ܽP級NY'nmUb^֪j(xoJچGWY=Oܭn#DrqjZ_iH€1%9S7?<*`@G.fŊFr{ WBwePGO^2gEh0Tk+H;@bW]f2-s[[t+forZƱh CoҰ:0+ `CW _T%yfk*N^QMŶTkb:nkDc*3뒧lيkd%04F֘,z>)Vx]C]䦘0"T[ZqI')6=a$ڮ^hWch:rҷ2ŇJVM{]gWyϮHK$RJԌiӳS=uM밫;p7x^N$(OEފiߣs܍P6W|nnO7ቕBbx@)+(iAg\2ݢ7/μq["'Ƶ9 HOwN>_5WGCsB:GW6DP9V1X)܋<9CI [qاfPortfolio/data/GCCINDEX.RET.rda0000644000176200001440000015722514254636366015646 0ustar liggesusers}?Vk"d(d E(LIPGf@P9*AoTw01yѯ{nGz̲8˳m-p#KO䌡Xcgjc#32#Y,dk]_yxsEek?Ox>۬(A&|󔑳<Fc^]ze jlrA=/TN:3Оl_qC[c [Oj?d4mgҫoh ճNď҂|C/Y~tR6ww 1/6+>5KPCk= rÚ]Gly2J-w7sݢ'忩-d=?qjJМ'D97¿}g݌mH \s3V,B8vkF`2cܬ)wn͘czVl>{x4ݏk+eJ{:IwKAټxFo7$%\W1^Sfټ!Ȩ3B} *^ O>>nGBч`Wd~*. d;UՖ MEX"{U *(dY,AVŎ*c^oU:BP?>g rN*n!-L&:C_s,$97( C/#3Ԋ:Uy7 'Om?6Yq؝lPyLm\Gͳb|oZsD֘_\T#\} Xބ= u J8ЮoR5<U!˕#Nz[g W9#J T/BB>{j.;- *wZ4? mffmތ^m\kOK~0"{ak.qޯi S^bqLERvo_L.w8ȅڌ <-{z*[~1zgp4ir[_g 7lVQaF.-{} 8JˀZ R&^3Z7OQA^rӋC#Gnx*Μ+BB߭C89|,IZ>Okto=VlY7ʌ'T3U=KuTtI k|!&oB_v qFݽ͚W ?H3ebu-Tp]h7SVnx%=+s;eu͛)ěYp%nʗ?G=p 3rMpܷp܃&IWE~x0uۤT`vtG_>|מ=` vqY_3nbFFl֩ȻqfߕU_ ޛt^{W+fK:mH,ʕ;=x}aGP;GȲm8|/;5|2^$N> (!gr_ 42 xy?:l2tɅ|dt -|[;ڳW+YbEBue ģh[~pj}b03߼c SC97W4_&r˲X5{wZw {^Ͱy%t rQ^ina~_Z0Amm.Kd%fK|l;ȹ:={)sk">3"\C3 VN]Y^~*M"O 9 DN=(x䶽3ZsqP_F gic{"MtׂRnU1u#PTبKKv>{N2 R~^[mG/o:*xEs O$wXG 2-y^[@F"p߮w |)v;ODa#YqzޒM۞ ۶Cg1 |A>!HPQb!YLTBPW%{\`?}c2͛7Hy} ,(@BNyuq' ^uc^ӣu/sk.3|a 93<"}G<FKWl'EE Baw7, h\xھvj9k<ӷyyjs ZWC&q[0)A =Kv٢Butq7͸_7&>Xmē-=a'4w[3$&o6އ6!ߧ|%|] oDO6ػzfț,<B ü׳eڋ#g#:Ȁr41c?K/Z.;n@_ЁY{NbWŸS9vi=(ϩdZ;4wRS1N3ۛ&,g- a) F.GҼCКюLSa.=*%SN7zI:;)>JrПÍ4Г=jt~(Wm c~.x>Hsq%(KΣqxl V1S |,ߏv#dG%PQ2w ui-Bb˯}uR7Zg,Ɍ/*'p"ebq֧FluqVX:C'`/#ZJ<|'Gq_,3u3WE/[W;^V{1w~C^LwG\ rf(rz[?E*Rcw,2vٱ# :^y"k]>_Q3I˶pdOFm\vm+I;z?֌7+AcQSy+[Sxu7;㗾%]9FT3TD\f^Kj0&==iq3ʜ[m uL\Bݼny^? Y4#uLͶ6#F]{/~g㮠͚oȱJ~ĹUwec\1[LY뻉Jnرe_"y%+ĵ~w4-z]ha^ۖi~$pVM+&u,r$G W}5sN׍R7:/7N{&B~~ h{(W;ʙ~?iE/'Wmm _*=Yog.7%K'y)q'_߂ vV9?̬ v 8Ԑ&?*5}je{~hP#I\t-[MVe[i _Pp?Qk>>뗣_E  Π;m GU iW4>A mꞚZ r0N>ȜT> X :x 'p>|N+0pҥ)k,gLRRc#[55a}1+EJOO[#v}MI:Yl=~M=`nq`[7Y J[Ϭ\m?1:45w]PzrC}7{, K71:]!݇Jg 2TAܝl(=UjUk ܏d'YD>´gߝxl~UNw^_Bj5$9c1݂onkw NdWOz"{h_cWuUSs[uv\zrwsC%/Q/)\\LA9\!}}6)\Oxe+A!J:,zIt)x>1)w74)W81ϥ2cOO ~UdF}4 w#?DΉe= _wևI_|xPJ׼\5]5߮Xr:~7}:Ɖ0y_/&->Gj,yTrs2}U~급~zJyўsk;[yѼ]$?ryLP?GU>t<(ѨI hQzjm'YQ'Y6l0vkj /5X,_r)W\lH):v|\:ON|[ cX!K$&xP21bxzжIǬskUi0,ںQ/T|)/l1=߿<+'^971nymM<Ց Ib/:~~ȇK۞71EugQ?gs9Kݍ _M= 9ϣXU>C=4|$}oQMGm60!kȱIA[*|.Xǒz>`J&joFYƶWe*)|)WXmb9c2'uCK6jYL;Zf=NHEGW46yw7IrnT~wuYBF7^B992pB஺sxMDp+2s:tΚ_;1Xh < Mz儳aYz?<>R[ ,CB{ӯב16?gl cٷDAue_?݉mcҠڳ|QzQv:!=|9$fE|)+ *2螝Q?/mMXn|N(ۯϾ=l{QHY,#G="5)w1 ^W;Qnlћ>} o>z~U?%Kg*cׇxɥV.Z֏&R:Q?,M:vsi׽V"jݛXOуOOPvxDϦ{&5N{h>m{%iF1#Z1=SPs2BMa5F0WNd8N@a>]R9dLǼI]?Kd)e%1y,#}?\9}FO_D^T8#_&ݶ_y;|UI Ƙ5;MK|қc ;;Nנ9N 88Vn ^L- jq^l_MGTש[t?8? ^Աr9@^5no_4NQfyI_O#L'޹{C!4LWYޜ;~+uayi%t{)/Fq"FnR@ Y-[3i#UT}rSh{p-i7۳wK9ӅKh? Ň#s oݷ57Ow_皜Qoٳc}Oo|q3iAz}=msCVqU\t<<@FY=+N F=[/^Oh/y.ː=!#3KQ°_y[K4Ch>?]uߪK,%wc{QDL[ϐ~\^g&JT6;@;MCGvIu$J? ĕF!ǿdmj!HY7:b<#ot{wJ{sy5OT$XW$:6 7EuGQ -O=8dz,y#DT~z4?,[.MxܐZL-Rn}}uȬy?\j{goz6~Lk=W [f+&ս?0˞GtQJ{GJN %Sh7rL/惼,jJ/KN97Ѧ63# '1 qq_C}.!zNHDPgEFHA =7V.E߹%HJ'bsoe5yPS }kMD>2r"BSسI^WYDupNz y뽸[9>&ЗQPiρ'k}RuN=T V)sTLht6q"c:~ O ʊ^wr=RGug+A(0`P* 'L\wnKE>NAP;ZC32&ON;j7Omϻή;1_G$;gqb{7ބ?<~+>C}2W">S wFoژtZRyØO%sB0n B7NU֞i?0ns/B;nU> (\A\mp ]яteT_bܖR;Р 结h|Ϟ?J2?(} `sn:&3'>5#;J\cAIΟ[ %-loRӦ,3 ٟH9`>^ڦ# ŶiN)xk[WznW@!#N Y˿#o#Rapzlwܭ?;_TNi=;j>7pr} C3X xs~No:")"raj >>U(q3p؏KVb_u黾SR[UO;& "5߅GǙrjOr*%if>_ȭ.mǝi[|| 3>΂nAKW Nd22zx"wS*|܋<ħ]M5k= FÍ0K}۔crZW Vgi^ˁYx:+:a7z 9wjg?u- K Go\.8S% ڽdSKzo?~ |{<*<, #½0\!RpI9>S/F.k𴂓W# yQzKpf2 +|e9d@`+ڰEڕ^W ,ջP7}?~~-u{r͢Jx7; ƝRDnvInJr=3ce~C|g|5j^7y?ga*,BX=}K iGUr /Fݲc 7OdG^-@^V=D+=?WZS.GnPx^-~1v9:$x ԟS(kd۰Uْ ?5920 q\.ܐD?, 42A$}MjUs}̪v9qٛ7smgX8S5k2%Ɉ {]B$a#nwsD/flN囯:^8VXf!Kt+B?.B?z,&)2Sih5aZd.F%%}}{o,g$O/Ov6v(Sj۸e`A2XQ$Ua=V߱PW<ߤŴ%p_ݮm-5G^ 3cՒ{xy5*GC }ʬyLL ?V07<{&nš')~^to g( ;y ` J쐃> ?al/M\xΥss4Nu3?E&Xl~ >UVV:,;72^@ n{Ex~#(w~gۖ]G0Տy^mYMrGbW˹jA;M4wK}#}[JDtJ{rcy?ۤ,ZJQyZ~ G#_׿Lfì8sĥ,a[9NJ *{NSB}Pl4dIإ }Eaf[Ar?.r룷H=KAkަ 97gK}Uwo;'PFXҫ]Z֪aA3$Z)S{M'G֦L.~$EiЪ<S8qh7|n)AK׵IoxMpOdkǜ t]G~}S)= ,ޔwxЏϬ0}ŗ?a?Gc\ǣQ7~ jQG;U'ȴ>QV>yeMUb~o]huֳv~wjFԬSA:+k_Uv[7p>7j;ѸLLvKjnr+#3s-%totX'~|0Lrxpj;x@-_)f*TfĹȏ[Gr7R6?~3NgjG#"Ǟڦs2+)|^)>{V;ESl@Z 3UyU[t~6kk_`o:ףOP&mVYs}bKJH1 #tNC囼 @IP4~.d'-Bz.ŝwjMvf385O(a\xcځß>}]vԹ!_^kb r6myn˯UDܦvp2lVoF?"B/D|&`ԁ;u11M}cGׁm CI:znƏz>{EC`~fʀ^kX oraxVݽy[[2r႑O^IO3nB>mX-e>͚IUN+5zCv8L6/Uסd$UOx8bw?M̾`9;C:jNׅۡ-Zjt~{K&XjMhVq{6z﷤?%Ro]!Ȳ5uÏ}FG^'0r1Ӳ<%׺2}0~zeIܠaw?)%*~d x\Y=PgV;?x:3{yuhݎ[/&b0 $5&!h3g9yϛg:rjdIju4#=\9P wn'YϏ:c B'{6#?g'B~:|ovCDH@pq;' HdzB{䕰F74aIEVy=:ESKz0we{9䋳%&LױF oc l|~>P%5a:y15&K2oW HVwbקύyg,>\s*;qd' p&UoP0Nm@z0KA ˟Kߦ͍8aL$=Q_0k9^&,%e-q(a&:r)<B>r#CO $Q8( > ,; (2`|~QfBi+P'q2&m/Yhinj|7m=_NWȉ7ǥ0㜷j[䝐")B瞄@1\4p8Q1yz$_"}P{IׁIkOܵb=gOnaz#ry<経"iCg ('=w{ #2 O^u*_o}ipq5ߘ ɩI$)ҠՈ$sx&̐!(jzJPhV@LshZ闭G=מ{*^ obcɩ*,ۅG ?y ̣_ֺ?s3^\8 N׷wZ>0PO8zu6tշ/uS+puQ>gOXWƊ]$ \_^xtVE=~ٝGur!Y'ob &q2-UF׵/9!+<%7pm>'s]Ή3둇=8 𿼺7!nmN qm;Bo5n /kU3=/;3Э?jMntu7wK])eS>iGrE; /^dV~:S*nS+3qv׆xV3OTȘNIWEy&NW5Q=+qxJa4 th9Sw!\BxM84[yCO0c3EAfg8J[04~oamnq6 ȷv,m1W}#Lrcs'oz^V_ )!~wԧفK>=uʝzKX~P{XK)j19.V~~4k]7AnE{y .nD+{ d`9;zo&oEX(O<"(mL{{|_ Y}sva^A+f*㘍orLz'"8ze[^`[6S);,9xa>]xLiȲޫjyOF:YLuU ݬsH/\ڦ8ZR_+|IӁ҄}ރU^Lg DL۶x)sx8&F.f:?ʒN.n:3<_"ʎVբu ?bUV_!6tU[sߜ`{^i\ ~S]t6?=P܋抹|}vk,wh0푑֫1 )gl=NU$@)1oH z#+}yX b`|sjE|h׏vE׮7rY+Ŗ]/w.?KcX͇" ~ ~SGq`S)#,^CT ]^YG$>W~P=~5,q뿗.^Ռ73/{d<کIa_K:0t[ݛ`9({J΂?rF8P:kGkGo~& =n=}i8X_F(}.faF.(g>Xy oX' cY7AuPOnqI«c5 jUX8V*}ެݬ<<: cTd m[tnbaý2Qr4/ܹ'αjgnRjFh¯h[F)PF.R+tuT1 zTr\RIJoq]?\yZr"Bƥ2uE/|].:p(% RYVuw$"O?f_Eux}W{C9_|iH2aQVT5qfd{;f4.mG#&`3>*ۢ-e?%A>/O/Yr(0.rl`aOזqgWVcqYY~=9=bR׶ZofR˙=gwޫ?qjYWy>hx]]v5/k% OWzk7?Wm]ם~:]rVv=Bj#t5H<2<|?%Juww*!H4.4OPީ/tυFoވ8 2zBз{!Vt{*͂҅wȻ"{ Rv%K7^Lw'WbY4m5i۪DÚr}Zo7<w=S[AsG1b4OPDYz _%~'fIW1K=9nAܤ>W~m#|ަoɒ [Z;n{)yxۦt/-|>k%FdėVlڎ1Uc fkks>xI/]O@n_ҧ'wz}%=KNꅨܣ_=5юa5#2ͦ'_D#ݎ;Ku~|gI~0;xX9[X<_!- hrkțȋ y|sD߰pax^\d2'~ 1;E1=iOOAfӟ*gX ? \rj|B%dI\`cS r5{?AnW? <;6mT Aߚ v:w:yumceK 1@ӧP )Dp^~:}'}ah=iY!K̪קσ̍C="T 0Ozb5}~}7`8\ozz Ugo~6ySVg90+$^ w'O:}ؖU SC?}F\6J;yO7zZ>nb1O{uѼT zduʚMp߮J#WBCk?Qg{}ˬ@o2[Tzʙ~Ed6*qRUti%/05ӥQǖG?O!7 7u)nqWq7ࡴ>䡊 5IT9Ijd|q3`/믴,uxp7ēE Rֹ/"YH`;'m1g~uЋWwle:v|c1Y[ &田g iV^&QqD eC'wk'vf oFA_.Fy{d[=rH繿k0 Oma'NbGle2r:fsCN'.uirgωfL}ׁ c?-r#O"jWט~?oھB. }{l ! ^sdlW/*HgG$4w7/g&W)2ub!;A|iϜk^j1x'&aw|O ʲb30_F(pH_ #a ~'|:9<8'Lgۺx|7YLeg,zj'66B1ɲo y =tM0 z*QV~{֭'] -V[ mk\uٝ-_@.r.S@1իKЧe)}>Ց }'"JE3o'vCY¿׻tS[Ύ [Cwc"LH_ ea1X;2A] gOV mc?x}4Ξk:6pPLhUE45<29xgT  6l|hϠ7MM=u |PQ8nh/Z@}=$eNmǓs$pz͋o^n2i]B՝'דEO$?6:b;amr| o d4Býs7]b MBc KyR {;!vNh7dG~_ߧg^|Hsވ#^dM1o'9עeAx$ K'" c胻ΕV Lm6tl Z] ^{J#&}G})v*Ҵcb=D} ~$q)=uW~ƍ |am82ȺہTq{sMUYXQtPʆso4s h,ST.v~"fsrO}TYd~7v<%r]#zm?/O/ 2#]S.<> F8J},&e,w&E κb+Į=̠ Ǹ̖)i+/mż<}qZ,sRlIu$^ w8ܙriBCc[+norv/pc.R&M)YR.sL[~5q); Cꮱ~u?񣔆*m[.W?xtwKwzE/2l!ݜ~OnE[={߭Èk"s 0NN|}d=t17[UUn/1xTh!.omN\YDu͙lJrmbFR0N,lN9|7Ϻ_ 3g6Whl:\ؑǤb_C&IcQZ[ziTr~W1`Ϫ$H촥es!W#')G:l&8CD8{}l}Gq¼?xWf[bH ?чj\tZb6X$%^>Q ?QJ֣O<oD~#yp;>C異΀|# ߰nKhr>,s\^!c}K{8}I雫Bi!ã1o3k?֣_)MA?CVwe^$*Je3Y iLKV%x&x\|!r?*RE~xH'?qG>+7y@1FT\]{Oc\ѡ5 ^#ɬyhĿmbr/ q?/3IEb&]'+fþw><2Ow/v3CW4'81Wb؅G#_̸EqI؀o\xȑn(xIuFmw¼ ܈vYޮ >NjR&Nɣ#oB|o/ʫLpiAɽ*5z}9OR4*mrᇥiwtzG͏KuM=}])GUokzz!vXbeqѶQ6j&ex>|]ÜmjX>lT {dE'92Je+-{A[d=^eX_j9G":Vñ^!ޘu,5cɺ,3 Ws^/7zi6c^\ _& DЪ[N" 4Ƅj-sOW_a*^ 7Wy٢3T5oi!#R|`oŮ ELDFo+=S/ZkEW9+G^@Xdd?ƹ30S}m#&-s"2_Vs%kJ1!Z?ko@2vI P~pq|UvW =yju򖍇G1A# 3vYZ޿O{MKz}S9?@?O&Ϩ_Wxex%⍵ ?b{N}999=~<}eƤ.ʊßv#K=vc 鎋c~b-J%/y;Qo5|aEߜ+j/чo8ϫZD~b'!3K Vf=q%YI6}zxׇqYpb'9\=q8xY̡n3x]XUUk1 #G΢=Ug~$uD0!߽[wE.0qyD:=0B11Gr9z[5Rpt-gy^.7ǚWI?T{o{Rqa[ǦSceP=4{yTߎ聾 YG9:en*QK" E+O|q+{|p2yxn|7 uzEYLimsY'S{j}>1%u;<0E(Q6y 0e=YujbUӛX$.ybI1*5Ν5Ԩ'ΛO;ڷ]m%񫞆Ŀm1ƥk\.5'/|mjE9 |I#.Н{;j'N܃b8N/_Ág{U\4ApP*Wu!"y'P~A=쎷M9`,ϠEߜowwx;p4 DD!Np%%ￜ3tO-R&;?nk)FyE׏+=gagwO]/M(R{:x\(<tX8 %K7s G?6Sy:q\i?R:0 "<|G.P|x&rJ7Q?/=ijN/o+ 6 >󤏌x_e)\ I쳎+/`>('wi6SH,ĸ,KW[Re۟ɽxy൭Kչ~_hmJIس8&Кs6 >,qy"M:;K3&x_MTͻfW>p Cp% :l\G*-9)+ZIMH1Z\]xa&Ϻ:}_&E)F_VJNcsTϓeLl. ̑JЗ-3ICaI!_jgNR)F\݋Oқz\m4ѵ\wȶ_OeQ"^'MO+v=dM~E$8P)LMWxޞ ǟ_sGJ]m#T>Q\7̓_&ϓ]d](7b]R/֚^] x/ Ibو<{Y&%xft5f-Šrk^MógWK7)ڠ8W򒻃A\T,?W?. ple3[]7A EGf߽G[ О{e/ȒM[/QӲo~T]uc;DKyI]C6e_Ak7>DYd]=ϑmt)aR/7ڸ}рw&^PUJSw/(|"u;ZD,pE䍓N{5׎lŕ^/-(Fi-WrRamX =ر[U{J |rD &ϒu$/ހn.a^TC|sFՐMw{ZZ$@k^9Ư4*|6/[ݣ{Uvdᗷ5ԛ$8gH̘ƅvFHdCR_J^hsI?Ou\'<ޣO-I*|-18E޳MH8- ;E9A1?SЫ^IɺL:N] ˖9qZy-+m] `hG[59Q2'kU%K0聟]چ WMJCnb1Y"7N'\v1b s}eU]9>ە_C&;Ra}Nf\̣$^jJ ,& Rw޽?-<}P.=LPzi=:jq7[=/3~#YtBa9,%AbroVÜ0-V! JA-IpsY6G;%zƇc1>9sHМХ Gl+ˡc wOLDکe){1EZ#Ϛ~k\lT&M '(iuD\^;%}G8go nL]N}vfmlEnj0| ?޷{Hv-- WcYϫ6 bJC,&X$,g@’Mi6{zE;5<|zj{.ftk}uo >dg yms],~o = 8W~JmȔ>Ł+Mn?&Ӎk_neK=s)πOQʧ,EI,C\FpB)}@t;6̠׆ObRFMEv ;92x ~ЗԝEd,Դ$Ϭܚ/jegw(c}M̯ʿ$y$EBrd~.m9/~is cbri] 'zZ%dr9+;:t"cX>V/lyInX)+H&.vyc-K gs?x硕flH< ~X^" q\M{^:$^<[u;9TGLu6s'eʀYz/-bYl},ǡSn]e._~TӔ[jԾUҸKGbz`?UR/fM$Ty~ש61|K{j-+_o¯*zx-P;OfsUGc);^C JC!G>o^/{p }w*|u]r~ ū#RbQM{7r݇S; umy:h@[Lh#Lzb*N$oM9Ac1x|#(qaUXvN}:Coͤl5-qΞOHܑ}xyπ=oagrCȅyo5j4>S-̑^9YЃԛ.c) '*SZ'qW7}0:'3vo=;t̼=U2(|-%{IKeO.4O,G\Tgbne?7mΕ(-hA=;&6K~ysy`uV~EĦ-Sy!j& \ptSːC)7k4 y;gdoK1Il_̇ǎ * ]9m־//KmuQšVAƖܻ-%|c#Rv>T+~g E Xl ;ͱqE[̝ 3v}+"rx]K?0Yl'|-I^j;\Nmiɟ- >Y(p\ۀ RWE'_#R7/TZ-Jf Ƀв-T-2ŝ2|(φI[F!6I 8^'=h~/_nv0#ړ0k"vO8"rynu%ݑǝ ?o~ktLzoaqj aI4#YghՄ[:덿[v vbPQf g[YK~դXLv+VB'͸#wxg̜J5;'ޮhob"+u̎'fTx QE91Wn]ӂr!a?t{K+-ZK~1\mb7O r{_Z'0isR/sB S:QU5?஍Que.šWk5'c0^W~AΟ:W&EVy뽈BϕYuV#mTS͟=Ych?OS+oehx{#ѝKOzі}7U|qŕp_(:b龅x6Md_-[WO?݃&d:h~=N]_E) Og%w+`DyȦ~"u;Co']!v8У~CX fSiRFsf1Gr&߷&Kcy=h7OyjOD2y+]g.@[e* dR+7CEI:ˢ77yԚJ«t:zɹaK#yֽD_?Ct->2H"\lgrnhѳ\ArNe{fe_ԑ4]}m}O^>&OS p;J`/(SU{%vg9qJ%ea0=7~O\s,:E"EY~}2^Yq!7/F-Ngٰ^{s^,}NkG ׍wfek_CC+ޟXnz#-F}Yf ?}\rw+r_Z|Z0d9Z㻫4жEg>R):6x뗊F£'Y(>mTxjkh.~9Wgxs/2"yN璺x;.>oYOC)_K.,#gGΎd>jT|xN?ZUg't1<~qCsΧx^o]~y=1x#{WM_Cxr܈zطI˫-a/|+f/Zj0A[=en'C5@_˸^hW)'=/uˮYJ80?h=9mܺU3 }woIcqcug?-ݩ1;b3k.rKx/:q:ROt=^Eg?83{~IKd1^m?dg?y_8{@cmHj$NWd=rϾO %.Ex'JӦEpTdc="^vvl&cΧw@__$uo_F&C~~wG:jd8Ls%8,%vxF(OpK;4m+VP)LTe:6JjOkd\K}"xŔm\͢3S?X}p|KZ>f;mFIw/Nn0u)9u˜EgU_:nTl~4P$\1 8)`3EWe܂䯪}G8xdtʢA+PB5.CLY-S?{:YC6,rOE96 }0&zq)M?b2xszWmO\zx(sB.-$W?kG j?oo'ueE?x6YmYL5ޒ#<&a}aW&n}n$dm XtnsO0x93kKU1~6.a\T8h kq+3E>XbӆBZoۓe6SAgf.B\d%dhy9$߂kby 5H=l޿T_Nyl| t衻lyRoq‹D~3O} _;u i/+ܣQ dw"k776Oh~qQF]R}aҿO+g*^ZdIx<Ǔ #R%2UJy]K 8fXv1;>:q28E<|uO^vUB r7w9,jGX4-?gU~qbOFi-K|н1x6{w8|~IdߩF9sEk윳vS`Lcb7-R';sp<%C$>d~$e^SXtGu.wޒ3'ZՏ A~/"&q3U+ʮ,&f3K^ėl/<͛}EB}KY̩7";>HFbEIV.g I'y_e |?w~9ڰnZvW<ַIyUY w:x_@ %:ͩ {wo0 dNڦysvwN~x?T*~X zM%C1$?~vje:Q;ǖt[Z<0K;uz; X&\[Jr.s- }Vm, q?UWK5ztƯ}OY\񤾭 My(Iʜj#& R;[=e;ݯ>PJd=ZP)7oOe";J9g"qxO/wC45^M <~9ϑv%fFd,'rZ!%>= 'cRx`޶Amҫ ؀F؍@RŶ~t+9Plv1+\x#dě` \ݫy%şѿ4健U#^DAO<Ƿ.!O-zY6w/2CѪ<7~nyٯyO5#3S`<#iSbH;Ʒ`?o^ޚ~FقSOS}2: }ofܚϥKu/^vvMWʜJ_R?xC~JL?$;׷t}`7m=6fދь}8 )Wh u*r.T~}ԬMɯIy59Yx>Q(V7zQpW};)>}0 ^5sMUOG(T&|^5&Y2>F^&:1xR]:N%ʁ;X<.}^eb-?=_T~1E0˨qHBJ# M"`mo#.pUC ~)8uhŦʡZSR7eo$龜.#^c9I3N9]Y;Y՛C^B /3Zl;U *oaQJ<}I=+/_W{ެjs8VVRȢ\~ziw> EџMpİF~@5wE)32S,1Wӿ/v7~.R [SN~/%oLyqnJOB|_c*DO6SWU2 LGX^+kF//)35Qg3Rv!2hq=Aq Q$-1EPy5uɝ&H?/UMR۲9d&ϴ7!ǹmOޝ5s={D,#ѭ 4RePH'C&}L z1\|ϩ[{%gJihߔm"~l 8 eS/?;c}2_}e%ས laݺC]mȲ@[~GZ<4LwtkxE7Հ7K;Ui?Py%xZR|bŸ2{_B/{g!pR,Uj|jw =v&u䫺c0σ_ :—~k-$ϳ!ZT)M(wKڀm#!|mt~bcz'qȃ}-}?HRJN%eIq^@9(F.U!"׼eyI>9e3l ۡS)_o\D1E;_u0E$=~IJKz.~27KQJ6=ekeH}׎Bc0z]K`i!7(F`S'spaszޕ.}X22֙opuQS Y4+oO^~K{(%ͺ v >W> V Q!iluFkϬOBDž,/<ƢSx^"B1T8GW6fhW76/0Sn:޵u)EG9j!u>ffW&]Łlċ&I"YtiKnmz12q+z&&n@n'=YF$kRf%,q՟7 UWu+O(y$oQvÅf/Nzٮr<6r!CS0{;`1Άf|Mx g.`17O,G3_Yו.Ωߛ{|x['y/r#[WjDcB*gl>׭~} [o  \w`l+${^*Po(ZV>=r=8Q+: hRqHYS,:kشYB5ƴ  (}ՖIJ +xZWy}</3瞽[7 czp|7 h=Rz-oh!u]v*R_}k]cN5MݩSl:[RiQ/YLēv##phtX^ā"XuhJ.Rk wd\>3tZ+4P8͝> Zˆ=|>yX-r~y:hžr̎D{" ߩ[*O1|XV,i X`?yߝƉvYvܨ`1%%0/8:O,y9_lGY؊O=R:l5NW)Q kM7wϫCd9]>>w iyA[/K/H 9⟂WX @% tMڵY˗]RmgYsOKւw\1ѻOF/wZJ2x=FjIkOSLUI#>uO}^gXm1 #RO~8L[s?#?y)EkMgΘtj [t؅5¬hOLio_ToyaWu v1<#} _:%c=j25UW'3{h<ٿٛb=EXD`<$~>tE(q8/s&H\*:}[p{`K;VB!jY ,q1P`o4J*kGԻq&%L)o ӎ`|IM$)vϐ{bGm<^{?#[9tKAo:ɢ+Ge5qn!}ۍng WxLGquM^+`夔ao0N $L/HP_ulẏwU"Eԙ-3Ǥɦ]GCݒ'r"olyRL_uk]Iܔ {~Wo辀MqF,~pua˵qG1{j ٥<n7!޲<އ%ɆϢ9rPk#H!6eq$oOHP@C@:?;w? qǁ"\ E)2 z[zO 伣OT0oR:u*!ۖĎ^qWҝF,~>r~;yT eKJo~xLwya5%>]ۉ֝_O΃ Ufcz, q>[)>w_%#V>JGd|";PىIcs.V3|{;у#عO8)iA0o2ﶎd,9Q]aםzV) S򮕳ꊒkO3lV$a&w:!a< OY"E+K"gW_ ^ȃA~zD j62wݔN-=18HߔB?-63k(_Cgt`|ů*A|c$I^ȩ)rGKԬG| Ux# ϻ5,??c@nR g.)pCz~+j^2,&iA90^w.-J5D2(|µo^=%^9 KK;{}gCJ<ñsƻHCa.k1waɃW=ro-ϣAw8Ԓl?5xC|dFcfᡘ# 0.qLWO->qYAͽYv伎:C8fg7PLN}l-T r~̳Z[qׇ粞}NQo1ʻƠ=C m1y-{iE],:#K҈|MYdM# # m@/nk R-4^kK }]Os]7lk.$<؇Z2D3S<2=ڻƏu@t 3s]K8Nɦ _|qz)ynZ$Rv]$ߑ|KA#kXODiӒ 2~u%νg5ѣ|yQN}l2A}O GKȼ 1˭@'|lWW.;ߣ+qs?®y0?d?0^Pu4k: 1Ԛ[l{/ ٧ 4 ۺ[b3q)mqvq{nC ums gY).q,3-8<;r艽j.Z5r_}9O:B\x0S-NwtWM~S"o!'M2y!7O CvyPX@߬ W4P\{EϮgiC淆:sjCxs._Cx88?ԅ9f_A<<} YƓM?k@5C17{N3}Qi3x!+1Q a|~~pq7V=#\(]Fg\s5vإ7`om$H+ɷҊKv@ }gh_fh-Oi}wh]뺍(h0yU[g 8V 1J9yS~=ud>,+N gFJ}rsYm}imu;wˤ@>5/'K4kda\$y!#{;m\u-ca9<w)b䜰>.:% ڵ2a>/fM6r>HF&ȋ EK{+DYy#={A,ۻBYoO Q4'%+y=9sPI;YlY~Oak4U=ɳ2z&TMPϯx?.QÅadJQ/Pq s覼gmHfn  ?dZjgR%ʮP39?C^tͯ$@<(W)y8x{%6Cs݋-|.zSd~ȟ9#W\"݁-[uoO$5ߡløkq%"tЬs}^—v?ޯ8}7jT>B|NT`pk|(|\!:-dnj.Jcd?m-eSd\A7L5yyPwo2?SMӐ\ThW<+v$?Yު0*3jTR=BA1b₺1fd=P'DR?69+=HH z\^KwcOS ʂ&2OC̅` MM?;`bSp-ٗL4>~3U YM#ȗ2}um w!;QIgw|'wL0a8mtu~<Z#`܊;(fړL-8_z`ѥw_)ڷf+b9)&t&eLE`7[x]GUN%]4HF{#ȿWLgŤmYS{'+ɨ{'!C|6{(p6m&ј' d#ɀXY!$)دb>o[F:SV>)b㭙LotN~錸 ʇUjC^ՒW(J(YH>wurw0)glj8`33y} ,|&kPwaק`I3Ki=(.:Dر5tߋhy<3ҷZQ`G'^dA^WX)(jv7]JqCŇU;vp/ YVxC]5WS7y;{{ZQu.O?Jx-~oߎlpp/*Ǜ7yݿsRW>Iλѓ.wnMd#klTf_NeMJyfj?j# yKB+&qR͊7ZzsUgc/|nܺ26 Ƌg%GXO:Uv~$8^I!{ewiį(&߁5X$D]nzE=Q :9)vڄ濑&~r_7&u\3Z~$dYkz( /d83 / $ }M1ݺQt/rgϷwyӑ7NxCҴ$Rv]9T@Iw8o3YpvKS۔ sN YS31)iߢo| _);l:b.=!l{?UK7yTzI)K"?!`BY82U7aV4LûfܬyK_X &Lpq FrԠ_>'(>Rp` !L$A%mL] #txi Cb%G9߷̓KOUSW?lE.{8 z`=xDH|FGoSoZxtjo5ׂ?r-П݌2Jۑ;V";]NR|p?GGno 0 fBxoe=ex+N3.ó Ӆʒo&`GRC oQw}|u5?@ 7:ڿ7NKR iYFFk=a"('w-ͽrNi. (n=뽖o T]GS"c,ѼYL_@2Cj59?+cm>2'HQa{J FyߧFڣUZsS#Uȯr/obw4ëE7I9R Ǥoߢsܓ.OBU ;a ˎt[uoU~OI/vÐ?+;?E浾 +;tэNK,ݔ腛g6l>ȴ ,Hp4|$9573 AcvzB*Y{0#u>#1;Zs_|ϝ~g$G'>+v Z{8AM~ɿǼJP_vyp|~?k)jϾ[}ܶ~mB&u \wEn|]vmK#vd<=bglcpRlw}5ٖq%0۬OEhfJCk̟qp7 Oh2RGCMM&怟]v0yN>Gf}sէ&B)}mTo'|c]sP6[ y/~Śaj,H֡vz dFq$l_VMKکI푖?@ąw~xܕE!{ =ߴɁEޙ*Nd_dKgC?d[ZQu/ރۢOT$y2;)d=Zs|bh~kEvVxF'-= ZW9~u"Tݤt+g_j#b <vwx FV*Aߦhyv |mŒU{qT|z| i`o-u=xpǽ(Kwl!`ծamPYɺ%kY|sÝ).= Ȳ; 0/g)j6y2wEC'}| ~:ЯڷԮ`yg+E~9.y峯dt.&6i_3[GDTúc} m  cg]8* a\7hvoQݒΥڛ}T sFs=@_V _!Y]]hc'1y$V&h8wu>}>#F{ɹZ0kt}WC&v7jg*ZyMđf'F~7)FcpOU9^f|x@K׽{p>vWoO/HrJMS0N;͇fu;v~g֑s׺pK{Cݷ 3ӑW˂[Y=8퀎C`\͏T#~hx[cj_j0ui"?!>R;zQu{BpAp _tR*{oGI#/GC^oՔ|wv,;e7a|?浯?bm?Fw _}&)ЏkX "l4H;[RrN5{ >_1"q~ˮD=BceYr9:_y KVJUz_4 y|~@OCK?D^t?^%ε%,k[^ Nu⦍ˠ1\t(e [:+=&e: _;sԞtFb:? u]:&wG6O\DOQ~1!N> ܁_W:n!gJ}|- Ȑ#,]S+ޘU5:x[˄"ݑUe7I0nӯ !o Mpv\[Eۭ۲G[`}'9d_C*#!jS=؃ /H|\"LM)DZP|` jcd<6\9HnI%߿&r6q?ey8X꬗$y̭ok:O]ƝQ^̵soC^#NuڜS9/^t[|EΏR2Ĭnͧ&("ӮV⻕N#ysAR';x[k:ff"h4wN_8?}d9_p@]"`obQ$Xf<'[PdF| v}pgl?4>"cn=uA\V?A">f{x*Q| sK^߶n6X"YpnpWW6Ƽ^A:PE~N+|Aoł ~Xp@uyedx~MIw8DP78uW 3j*o?ȩӲ{-}~'U)9E"Fw>g7~iQd}r]'O6wwv=G"*U贜9Gv+PK}z)/(FɍW9}cQ-zͯCp~} B:}$KiN -u91D2CkMJ@/K]yF'7c"\VnuZ?^a%K` kf&b2n/ A/&9Rꓫ/#߱U-#N\#f7\}ņ.z5l-Dee@^W dZOo;3AĚŒnn&i0JxS PWCTүߘq橱mT=GK.0=@9giV5~-߸u;0N3mʂeYVqr'uQN޹.U] Zִm cm2/Rs_SG>}z\F\sgͧ ZDHw C܉ |u--Ǎ-f)T|Jڟ@_P(I#㖰72Ndƈ}=1h|1Im[6TLX iAn|sVio9?ïA]b_XvԢ|K-/OWWed^ [_=<F@:ꓺ3WvݷpCN8)]H8Ԁq 8e^^fiPuI䒸_!Fg C=3?~C[!G$^ K5B -㫚|/3$fFא8.>Np3:9axRJ7+T#S/N2/Jy B|XL}h ~HN17bkӎWP 5Bm]3t,.RqB>$R$Cq392O3W:dO-D)z!<<)6Wd>6xF@NIc0},i7A^b7/ ۦ@ȱ<#%?Y7| )OmMHIJ^8jJxj*Ԯ~{Gj~K5ɾ7qb%{}6^WVRVVU:r(} @`*SXI#Q,vgM#<,#;&KoDo; q;139XBvrr3W )6x")7ߨ g1g zVA>1,u2+qSNo0Y7%>k?9e#iwCӼmsO{i8Uײd vCg2=;MD:O-[p?Z2wM2_4ʷ NUِ/|=Qn%u#95r^mU7Chk,wD2zto50~AURPdwloUZՓˋ=@ާD!y^K]PGgįEkٯ-WGRCSr=sb.}G;cs`?iCܶki|߽>i]TUwkZ5'ŷiWHW@/O`ׇv.볕~oH5{hΒ=. ?! jz{`@A(9MWth$4Ƃb{4;?-zlrk9X^)t($ :ʷQPw \zE1VHX=j!sgl_ژg=]пփkHeN .Rd?Ψn~ܓkxX>xSt7؛Om.ypEh+[$N:UPG;Ťed6yzWG=*9)Zm ٷ,k;G=e佌Ms+bϪZm qUA>ȯ<9aamMw^|L1s!wK>q^Js5}:O Wih/8пUzGf-Wݷ,kѤ/G^ 6;jhy+IǷ>01)d`[z,;6GUJ~=)~7 豿}ОS?%4|~ОOS -]NO]:je;nK\>n@27`rnhw*O\pR y3u7sS׍҈q(:{aw.O ?ϳnGˌdx )(p_Hdz}=C&y;@O웧:*4]S"y.WA~AkPv;[M}cVO! fSdf Oe}K-V~z"zlƐI Uq-L>ܐP|?n_z] Mo/'}gv{zkť G{-WCULkJA]I;E5iɺh-0|8"' q1,? H4p⹚9q rc[SW-{E:ݢx 5!Z;um;p̫s4N8^zAƓZkꌞ?m UYĶ粄-7D]\7zԽ[ G{]C#Y<,h' U)CĚBJ}ghiG{1V>v[3!~09e͌ '-NT[_@{&%z*YqG1\eoLJdSH rfe>;KUsG$^v&ꇼH.3lr<&0s$* 3L/;9i}WVM̩; d?xv{ߞ'h)F vZE"EWy(Fiw K {!O}~1STrD-i{9ď$n_]su2hưbr0G0WʷKR4˯ss^R"ylYʛÁi;w;WB>b^*G ɉ'i]v3d|殮cA}w;A^|Wٞ|_a}mX_G #!*0.p߽i>p*c~[iJ29=STNo槁69[}ϸS#`u1^yaN rr'0󪋳Lo' U%/(˕oiewx ToC nj AoK\ٌKi)E-O3$njWYyU7AJo>e;̟Mv eKJ])k=Ї؊ox<+qcW[Ct~9WtolSI3~+&Kho=qe+A_H~#K|4NsI&Yޓqe~!yROH[CA&Б֩9jp <佽#/ؼ.%5I^h@NNdt4IJr-H{= )k^? _sxC\;kF"7W"_|K7eW!_I/ >_xE/z"_k IK_b &ʿ{\C*P5K]DD)ʿQ͹4B9o[S#_W|1_|}!AʿAj"7{Y(goB~:?!?TAa;|oA-p27"P3) %oEM^7Gb_#ɏKG_Bu׶ȿȷs[jo|m(o {(}=w w#(. ?|v件wg^{TIE](2uA}Q"y5 C_F?mD!?Ѐ71A!]pB?ɋCU?̎5×aC~@~K ! Og}đgA! EgFnȳACyg9Q>M乸GܗQ>By,繈<Q>)|UEEP2M!/yRQBz "/4OX Ź/D~&"4/gE7!/X F^\y$;x%A^-R/]ґ_ e2/ E~aK@^ +|Qey |Ye_ŏ*'W;בD^y+ע|<ȯA~|P1 ȯ_g >_Q/ y,}?#yU7*$!!|P Ao?܂W!LG>!2ȇJȇ>C>l)aȇӽ?@>.ʏD>zAG_G> [cP~l-qǙ#w(? c*OO O:|$G '!<|.)ȧȧmE>iȧAgd ы|YP~> T gǢvs |N+^ܕ!ی-Cy5"/|(!' /!_|Q'y/Fv_EkOYS/eAȟDg 3ȟF7?Sȟ@|vs'?7|6WoWmA*~MW!__X/$"_C6׶!IK_z( WB҄_B_A'ʿqtGo1P~uD|='ʯA2";Q2#U; eߟB$?#=tP~C ??AO"ODf!P3U䟥 *7)x!B7G_B%忖Fa_?CR[$P~/- ȷ"|o[Aߺ"[(;# (/!Ɋ|9]f(<` Ϣ? sGv"O"߷![| /GQ/#ߟ|/_? A~ߔ\lGG##xOY!(xÁ?E~DQ1?Cǖ ?/76㋐wF~(I;'")6?eE Ӧ(9!?SoN[[T=^'sofځ{o'{=6gv~nEkwuk%TT6**(a$cM%r35imb}?n}k~8fPortfolio/data/SWX.RET.rda0000644000176200001440000024250514254636366015137 0ustar liggesusers||u\UMP =tIwwtHwI(X`( 0 ,0Qp ~ߏ?3kV^kLf9 `gO¿ DskefZ q< +\%zZڤDS9~7tI!۝ R{L?EųU,N ĵ0X<ӂN\Tވqi k\%9Ҳ$2&n$+%AǾt^G0lLD8͗{*}yڌk͵eDTCFZ߉Y 9. i~ob`3G&!Qs퉈?216 :'<귊 1Nz[ȥ} \;']5Wڄ Dzovmݿa =i,+̡yЯ_KPaݏks!uFjGzwK-Nvi󵠯}:7%!o| ZS,7m'vNp2_}ڙA]9CQג.M2̈܍8q+y r:hn받W!˖֘BeË+ `Gq10E>YNضf;* 2xIb!~.zVP~~LC*GЈuƩK&BoƟ⾁fQ* o/3XO-ݒ&b=y^_`0V}ż/4^ӄMp3^tH,-]a^+UwxW?q#h|woe7M߃@kyɸozDқޙ [ S $3/yN?c?'No#rSdKC#-SKgGmk|n#ĕyk=0c֍AkCҽcwں,۹kgI)OHKTC@eh%]~{i [SGhqqϲ9u׫*GP3c2MMŹd_%:W۵aȩV)sTŽ %{iH4SpD+lq}ٽ*$LKЭ>pҜ쾥ŽfxV\Ly$q z SڕՍ҆ta ȣ||kMrZCk9 %CVOLQמGò<-1O$Mhvɳp-9N-Ʉ_iɛ863jqLkxL(J^8&8>MZ&Dg:--~.~}9yLǫ=23.O 5 -|N,I;b_+o΍#2&ŇG/Z)N#-a9(?F'H#1l1~_ZU6_^H/'/l=M^,zKU㟺nڱAnZd ?rWN_ЫUv˱bNO;5d=LYyQ@)C1=o#yWE݋RgX⾣pг8q{D]#GN #ϚpPޣ=cID2ML܃UrJu&itieVجEim65&m|ʫxn[V3OG=#|n_Ыg/K hKgdfaW]@3igiMz̾\}9yF͵ΤGk)[^kyV 5q)<ӻT:}ϻh hD|uupw勻DϬ׫b/D<[; Кzi?UFgYՠTq#3%~[LgUDP`u_ YYVO/HN>VK.5g#{NN[[=]8 m Hv/8β S`7ܺu!HB+hr$gB}yאe)(w+:"lWS퉰ueԣ_nKg }ߩc5;8@ȑ!/ĕTwe&t<).0o*vp/;:4({ۙ#|O{r>Xj2Q]{1rB)UW1LvŨ˴(U&Xn%'$t]myS9K\X5WV[%`~՞pLeY=/a<g|Ϩk7i5cpdΪ\2FSg6xapy/qi֩q7K[zˬRO3o[mOv<ǐr73&ՒH_i:B,ȭ3X 1>U9J_o1DyX@,e,Y-h{i4{x|L C'LzAyRBk sZ#}[ 4)Zu(qy.\9%Q~q9{rN뙇X'*n!}$\O & y b^k:Ȋ{dM:'btb޵¬B#S0guG;WkGuTw5׸xZ+ .~dOǹoh?mOeRw߅<[0qlf&ŗeW֋:i_j(ΡNOb7SO 6׏{o0^:_p1$0^ӛ%Z/КFؘ7ST]ٚЗR˫.!gށ۱c.__҇$oũjt>}]1SS$ʋ\A7A7#]c؟;d$ֺqmwHiFMuEzh4%WO⹦$F?/AK)yF5{N.h?JR'>G[4fDzwpfc|嶩yW9&k?;[;+=kd"o}}*_NY/l_,\{{Pʶ\z7oRG?l=iߕO.Iªw{7x/cUwRL¡t{I#ׁoj?>.alR1~w#rк0Nx ӽ2ɞeN8H[)< \>Q=-XPr;!zp/3g VOB\ >hݛeoeQ܊~&_ry4VTxTMF~ؤAi{GѾʇqNk-SmN﹟|S\箨uט;moOZyi̲]?$$s>F]dktI^#2{vATG{ם_끝.FhvvOGPoH?XXi ?& jзQmjS>1z8Eq{62:_z/tQ5!3*e&Ϩ?,Ll/{?`Apf Tb+~I丨(ݮNq_6W=܄.w{g2;ʗ㸍X3u2}kۄ/KWR~Bîʯf> =M?us8:N$ƵxBZ8ū,\yK8fPpy/]9J/0MgM?pe98 Q܅kVAGij'e(=qgF05)v>ro?^#X3M2x}-"ljspy3\ϸ}Y\#9HqNRb0\L di\v| n{/|~"4ڗ~4nj*-F5)¾]?wcAm꫚mG|54o9CKrgF|_ɒ:-mzo3?WLO5?J b5!%[ xi#Y[<[U[#5N~OD1S.ʊ]cI/ismv75:;s.ϖBn%S1ga /9qYUFQK<@N*пgt_ɶ_ َc:Kv.)?ӺN|:ATD)Moq~{59t7W+oFs6v9En(L_/i?X[CFx|%Rɚԯ3#T]cn+pO|ZZ{S tZCu2;õh8 &qPr߷ei\FyacQaC> 񏽍CUCtESv~+1Bΰo[L}ξ[7Yn OʠOw+0vN!M3LLExߖeKiTU{HR=5~am !W #h[Mu-;cP~  פRAI5 9lvEݚLqu{}3:dqf?U=F~q+z{u]y)ط9ח3t,tB.ηv"_a~ƚ]f!٪+*L!M2ݻ|KwOv7ߵ3(bǗN?UJi˜j{NcaZ z~k;:1۠qW Ӿ3q,Q=.f%9:#rB~W;^)Ѓ$7X:st%=w}xS7\W) z|^E6OsMEm0=px4sVep. ermaa a_AULVehk7=W)? OfRb#ӘvBq{/fC= Toο /{n__?XVag|UYQGyjwua/T4.T|џ.uq꠩S~| -?Iu\OU}^>kqJiAzԼ5 ݘ ̧?| TMoRbuṦن.OZ{>9B3j;[Gi7S,1dwɢ͓oJi ۬elz7z6Y3_z{}Wj MT g'_E"a~N̝?*98ak/_!<}#Y^xe:ZZ@\+!:jB#!_N ?\{[fGcSzvo. ~t.]81\zS|:r!ϋnגg5AGk??-r#_g/~ctxys>yV m{4}?^<\oz<1Z?;^nςǪ~<j߱NpB?lҠ/__1tF4xC5V*6m_͒\CJ\Cz#eSw̿xի+ABఒYpbڪaET\ls}@a7`s7[ Jw'5[iuvP;yLvIP\TQ|1lyJ"._vSSoW>Ί!yV7kC{)*grzk%}Rz\ iD=dKLWj/Ea$o>ڷO\DwBz7·?:̳R8{K9ܸIWJQ+Г)|Ӛt."}oC=O azK]τ4f~҈~i?\fr|{_60~Ƅ雡_چ5oa3gGW+z_q@;Qu{6>wL9{97V%#y%`aK>Փ; ?͘B?ҭ/qx6M;3wqڊq p>oԨW5G&?So4.;r+x*S\70|Wa$1W<}]B-Rl' #y/㹜ey)1] {)t !*>|O30C{/ c,sK) Q]3' <*ZK_G Se{i^/w0cHۨҾULogZT@'L/Ucda0p} b*bG ^>%$CRL;|hŮ<8SUFru:ބlzyRAW,/W=3bPi̓KyJ/m3_m\0dϝZ\Q쿰sx:rhU(Ou",ѵl ~7,Wx]"r+o߹,:Z?پ=ܰY_7.6T#ޢsE#-FSXOEs0^çÞSN\S [b>eU`E38g/V0oݮ} s|5|Oa{-X1ޞ1|2/CN㝯l^ ޑ?X ;Z.8;D&E/=aXlz%r;?ʖ>raթ4oka%>ȧ:uUcܸfxbsm[-WГ*/Ve=yM87//YiI?ڎNV_ if۸*oOq"cߗFF%\i;}y ~btʠ!&Ωe*ށrbrT_<)#m,+PAEg7yn1~aݨF[ 'ZCcik779$@6RnE/ exJ? E2޴Urð`q$쭪PJz`,1t0`jt'cK ZI:гbg~VSyoNvczRU|iM}dBn+'W6 پL3jo\E) Մ{פ"OJ'BB=9NT/ĮU(s%ݷk#o,? { qcM'"&d>Zyݭec8?T%{zZV8&p+Wq:c[;^Cxdnwׁ ώŽvA}eEӎji?ݲO9CC h]?-8#ZӗEi+38̪neIo7Pg^P30TX3iM=:52~Oj gVn62_Q~jG]L.@=;ƞ{$Muvt.GCkW ZksҜE蜝[|?a֓lNM-M>lKc# N :vf.B|a&R8a٤u$Y(?Yp8>7oY7|'kS0=D8s/\݊ !ĝs;-u 7p_-T}lS @`;s94sZ|RG:O)>%8U=q8MRrG[iGS,hrTwJUݼ=_Њ|y'ĵ|F*y^Oq_фS]yz?3]M˻_~=ܡm^>'`CRsr,5yZ/`}&տ,ׄ&'ܾk׮.wӵϖ;۩k>Td'.HU4-NY!R "/0U4bWUG6/޽EgGxBƻ=a ZKvC [%Q-x~ΡlB/Ք~B[ (ݘ}PeG㘥7O2nmgOz [b|7gX(%.m2{):en2Qh#z t>ii{ؓ봇Gc/wwᇙJ-\+Un82 põҵiH}+Z&Oh'3F~7֙:^k!;˟CyjWW_Վkc'#-.?91Ƅ;Z c]IJъ|Aɑ)~8Co+">GY3 }Zb;YFwET}xĦB/2sݩ> z:kl U.k?˭}x`iX_~t3fכ[q>{-ܕw}<ߖծnv%P~aiM֣п6a97e:͛wn4#{RܵpX׈oȣ%2~.)f\v}v6$Ź/ϻ {+J~E]2oP bJ=9Z໥Hhj?B*K@MpOk}HUmD~ՖlG_}L2m{}?fNiKuH}عR-cBN}/">~^^\v\ۋ|Ssf[฿ \+E\]͵jW>2c=,QX:g.A[q.pfZ2J3y3- 57WyY;ygqָlޢhks-+ӚfA+Q,g7|bMoY67&6MXұ(F"$/2} f / f mL3Kp]օN#o J-k2gVdY] qm`=^*>2S!L_ޭ+`FE"L.w^.lj>۽F"wIeg  Ŗ]5bv:q S]f {D2X̊E|5{)]UKt+fxux{nٻO7T>^Y \_~KfjzA]oiiZ .]˹Ǝ:7bW'Dma> fXà@4똩:vkt ),-v4X%f;z0+&ZKx~` /J<4;"w'WM n="mWsy@nż6.;(V}s ӝ Ih/olo0 G+睭`0C>uӞ=F /pw|2%jbLS_04R gxj%i:ſvg&,3s,~1k@Ql/aҳ:?o/ЍZMZ_7FInO3GeIۤ}8OFG(xb[qjx|p5?(_D7`T%*3!!>>.]T%7E=_DRy/Jr7cΊ)Bw>pq5rȓ<˚O\B{vOn:?4γL~eb)NQId0Ųp|?^ONPﭾ =,(3^7 yacwZ*3NvΧGѝiܦU:Y!'kxҸvїNWZEGt%gC8_<[*78L:ka+Z3C|pR`G=)!xt"3ޑs+l7ρ/ NomAb 9zAPÕ5nq#?- YꃼNŠuvAO`%F]97peQ Lc_LV?J[#m&mU#AydDK fɎ&R].Ε~*0Ot:e~}VRvq؎N:.r? 0یޓH}QS6o!VeUsnz,_d-CI4 ͇z'!}R{|wRCPxzlczf f?giJ$_WX0{ $J;rʰܮmpnטb(nM07][kX~ ŤmɸΟɼMq5}OSυ>vv4\=p/*]Vwż5[nW5.!z2P=N`}͌]t9}}:ԝ맬XH.UO~k%F_XwK9?{]k.A-`R|xz҂}OR_܈odn^Ҿ^A6թ6c &J̝UT!.mC'>%-){`ȗ-kqO.4:_i۠zyʷ!rO}smͣ26ȩ;1|^6 m%{î'pD ׼%on@r.) 2qx9P`c#`)0u٬!)^>jY6YSĩi'JK8 %kwA?3U?LPR)%`e0>#xpDA|KOk&$] 9"Z&Pޚ~$߼?޲JC wJ7A"g ֟/Nג#9v ȗEW.9{n~ ;Ө(Ay?tFr\%?×;#Wy|U,{˾#a9R UwA73%A߳>w`H-< 涹q}K2vW_^^% y9Eg.ӣβ xJM,#:nE:p,]\2e' ۓZ+"8OPobddKߣ:sú%4^ⷰX/N*3:}TIQƾ_){{^)\/vR]0i|"ࡷۇ}p~f6NIr:%[%}+lA3ϵ=K~:7߳_\Jx 4}{%x݉X?1}M{J?Z8lc kC_k+5'eBEk1XV~~MRlG2zFsTn> :{GI\'4N.>|<˂/YCCI{Ɛ_%=͘OG3{_*Gْst|͌[ :k AoM!Ot'?]D+9d1n%kU!w2D\[6r~x8~#;kȕQC,ՑYD'=Ho!oO|uZO1 iL+c 1#1oFE;pfLʇ)O68s)>ן輕-).:w)L_jwS )߻-+ٟQi{ } B?%M~׮L[ 1qyیyY"#]}:LRdVNYQ:轼 ]*JrLaGvr_ƮZIb/< % Y-,=uoYz/wArw®[mOa>M~QMo  fʛ"=ﵡ]y"?p#}Nq8[Oإ~#,3T3^]>ϧ[e]gv -pQʟjƮ%Qפܷ= =g歉ܺ5{Y%Km"~CwVГ`:NV^2+K v*%N|2?ܐKWfH7ŕYKk=˭O<} }ƌV =obl¸ңwPD`*Y1Gt[(\<|F2,Z}'4g6R`B~o&72kk6kt;\ݥ3Zx~* Wu[dW!k[d[`vns{9-IJ+n/=KaM2WH$gCPYU=ٱlַ׊mmi߻$ q^ zw[U+f\}uX!iK,)\w>չK_ ze^Y'yA6vb[WCs-yO~#Nv<-{F^+-h\3WX 9^.K:p1G@bf}Aߙ[PEjxb+!#߫)B.?J w )+:*$:$&-󇁏IۿxWt.CC]OX׳,֡[[aH\)yGgFٸ簩ӴoigL <$~r6 Co:w&6!>#ZMW[E6Voa0yqrf!ApX/fZMZ'mDAtC?}Yt ۇ#ȓCy~+?7K5/l}F~aYDŚGBGBJg.@ɾ3Pwn?=|񵈣zq"sKاe#yZ?F r aW#eU>[YDf/3i_bv!3 ugV_qy*z㷴3¼?NrdfUwgigq;71XYcƈ'7®=?]xVy9NQ~Tܾ joթvc[Om ojsAD;8oZx?^\̿vv Fjn,"7l/}^re\hCY}C_خR$gѶ Uhmзx`) :SFژ[ Ɯq WyAc!c:_jk5L?R.hWFh.c6I܆>#^#_m}y=QuCD|>D: }Ƌony*!VÏ7o{Uy<usLW>ז&gڛ\`9&$Q^Ⱥвt}5sJMU(ǙBo!Wk_1ѽa𛧐YnYpDc׉uB*Ŧ)x1A]KPW#Y˙&ns U\[Lh0aݦ+a|>>.Wc\øg)w uhSEb#xR>ej4t wzD]fOvx7%C3|}s}+!kqZ;G1`/R\λk_u5Ah}nZ˯ЧCU[?G}~~aQr !.ZWĀvWY/y /X`~OU+$h=j/L,r7]ܷF>1]E#L]W6y1X^]M0n;~ztaDjlŸ ۟unӞ O++?ݥ!r%Ll~]B^vίxmu~qúTAUޑ xؠnNOrN7Dk{O[CR 'A?wE3 ?˜HAJoIueHP0G3~wuJԘ}5 +UCw6Rχ})Zq䋲R׬Ɯgg _E-0Τ'>6`E y&?Cr-\Cg_~GF"wZV. O򁈗\Fг8:3}y UQ WIaqw )˂=s8-Ӏ_1:כuE*2I)iҤ:ͥyi;͓HD 3W8eDI"Bd{|_us^Z{׺z z>4Ϝ?[x'&,!(kݿ(zɅ YIS1O7oh+3' y(85Q'cO Oᚽ聇ߦJKQW&!x\>vebWrV'5D?8rL=NpaR~3!KK\=p?|݆I)'6yNfOs"d-_3>dt$&}^lau }0xFlG8f9fZ+wfG !=eiK=ٿ^%t9V*ȣMUcj{q|/^@1ʺK@\ AӦ~(2)Qj]RkTVJvg8ֹA٫^.$%EΊl}& /ګoW?[VVL2 ^}bay)[s]#Ieз4g:?T/Y8h>b?1&qt;]՟dKW(_$>R散,_uZ|KsE2)RTݴߟW=4e1nLBLNu7PUY7w %4Ȩ7\}Fag?2wY7k ؕUκ7u碤@TЍ4K lKV4M:$t+Q |_u _b `>?+d~ ު*`Nybdr~q9A^ܿvDHkzs{8<9k:cvkF ]}3G҃܊#bdJ۔*,3rהT_+P{cEϐb=rB}2|ya(&ggw T?s=Xwl ȿ(>&w/6$~B.hSnuP_ }~j\EEz)(.M+uTLsJoȝ t.Bm %w(Pqs^o +.ǁ}g|[`W$s(/$<[R)>x{&Rt~YX;e97d(~䔹 /:>8`rb]S}ojDόT)Y5_ :AϬSӬ)_=L)LF ׹7_ܤ.Lqa~ @xPry@ɭEGtt:1GIF '< KucLs?Wݦyuxb9.)@\ag8* /^~N(޳xRˇߓ7_#V;®i> mԩ`TP dkg܊aʥ}F1 q*+>ۘcHuR׺(xY'W n+`7_P-WE+y(i a/rW u8Lu=g|L7΋\'}s^3dK_9WqURMu'=9foym+4Yz-AX~؅=!EЇҢ?!/; /l9YcFR RC aRb h\%|;쾮_T/*Q6|bhs ο݁I$Pt mA|"r/7oi*yCzhp7RaO,SgӷJ|/dY!+3ְBq3r Ny%ޥMK `o8yuy'?z3YzЛ7~~/=[CMnLdGO_aωxdz|)bp%7<"FБ/#V|j/m$o 7=G y= '{T2%ESZ{/¸K7A 9tMsOW7mZ;/iz_Y\m1twˤg2btn_^UAje!*ZL7|Kڶ/,u Gr]l9Ze9o~pԗ͛A|MN8'pt/'bEL]FT_?)zj3i}x}% Ӻ`1靝x#ͅCTc7ٻ5IˢA廂}bdP}ˆ#`7X-\u{YT;"a|Z/]xTW"!r3d!HIu*WH(ZUI]BL͸ ͐` u:,WЪ\I$>ݸ SW+v(59`|7PFm ,ҿ*Z/M͸ ""nu.Op =31?+Ir{&`XXK0 !/O&=H{x5BeǡO)J^Wð9gV`s44{TICE&u/"gQ]N?`\ū#[Ƭ15Q*1(8.O !aJ8J݇ mZ3}a_-^^FqS޻7Q߫K'd?g&yD=Nb궚~K~N&htjA-:]mX{pnv,^\bYNҶ}&T?fC*wKm=oʵ>QƖ,dpCGDlswGTώ{dy'0 DT;PLO ` [2ujv̞Y3uZ佩7  _QsbzyąKeTbMvzശgfNƽ3bV] 鲩mYZ+aOqꤔз8+-k㎰a_7[ b^÷r{e17;z06ql;ɵa#8fh%Lܡ{x+mw 䥬.!gyq(m<)^~x)Wשu~t"9E >3~>l֯1~x$vO?|Jԏ݌v8ǯ ^)+ 2矜q̻ /C ٕW+m԰k|mRq:Q-GPG?CݝGITFd"0oH>f ?bh^]gU>V-[K1rFU:?s"G?Θ9Y=Uxśʿ5; 5JK[= ~=. |-euO U^NUwsKicn[-y8>HwPu)գ`=n\0aPe8)<۱M ŏ~ENʆ'h="r ,L3Ln-94tGO!O҇5a75- p [t ;y;cH3_MV!CEȄIͬ I)rVxn7 xl)cb0k)c .Nٴ:˚k%Qۂ ݩ(}}sa|)ck蒝Ћž>)t$م3wl |vS?au}6L8^ .dozEʅt?)^]fJw^;O}Qxa$)KTO-D5%Tm"-xO1 Ϛq|IN-_v &tzՏJ93|#+~˨zOH?%a=[{gG 'lOb\vlOnK낯+2\8l |#=z:n1QةfυN|?՘(/AȚ'O|=[t\21Ҋ׾f^NӚeOsoJ:&Mq g.;!|85uY0i]}P$:^i&bHQU,wz(D~ߕ~?o<veCcNӁsO;v'ˎ;~?t,.nE~NGGf\iף(]y34S{Aumr*B4_iuԴe!oO/2-wmy[->z1ؽoѺ}z̞Ag=ۊ:M!G=৕ĴT3 1gn}^8}px:v!*T r9ls'bF>}o[ԈUEc??Em-4Xt0J=Q o G#qt0$%"2>O,ݴ`,$Cޝ]:O1hfَ.!W_DqocOYsDvQc 3L?-?B>'n CblxÜΏ9.X,OϝlbH3={G#= x[B )>jB6_AB]7vf$Yq_A-} ЇlJX,q ՋΤӛA <Z}ߍC3.RLLq)0١|fk 8$j;*H":=o=fKUb#{psm(гq2esP zܵF8雛T?Z:m,+D'N{F5v~3Uu&'Ȋxk%Čx/5?-ͧ/Iϲ}=:d 7L{/Gzuto𵭀@JSow)r^— >rS ^M]rFg׸kHJn*dZR?If楕O@Os߲++#]@$횪2ǟWbXi޶z$.֮uNTO%`D`Tǻ'1Ie>=ra-UHc~¸VqYgoKnpo-z_xgn1!O>Pfz; A\ì|ԾvO .qڶsU/ 2bgLFҕTOtM~I4$>ہ]iTflˀ7ҤH5I{۩ϳy"߳~7'H]T,{GI?Lmi\`l?<&n2;l ld ݁y=~!ZvY xo2 rї㨟{ b^wٙT2MIQTI?W n'h~doY>"a qӖ@؅Sȕ+!ozDq絟~ƵC"} *@мt}xR s]S=kjkfd=Mx^[FԈ1%v=QCNMӺ!Os^^' ?(o xh.U.BnO#8^//DqTŝnk+5&Sz6ӴG&Y;vSıAsW'{_uO*` }4OIv7QH?A+ 7Tѡ}}+i,gRh~iD-4K~!aJN+h?$%17qvЄ ^ G,)2GEnmeS鯎Է O9E^߱~Fpvh,!/Fݠ_R2VlR|gǙu 1.BC]ymO h],jPpY}{ p㹳 :+8wƣQq{si3t "Rv]#Jy?;>] ym+sBg/n\9咴<3gQy_'X0pυe+@]^Qjw ;\T&= xfrxky@NoZCWZqL.ҤUC\h^^.FOSP蛠 %N(:yFR43u]trls}gR}`gX.q[k`jl|?&@r4 m4O]oKusf\xja|i(;/W  S]-our竪H\x"qXO(q) 3-=KQx*zx};{~ωm +g9c Ѓ8ʘ?y| nWOaw rϑ6t{dFNgv5rljԇK`C3œoF<':pq*.s7]ܮح=vyv{KH|1K_wMṡZOmήx>3]T9FλXH=Auj5; O`d-NxnaJ=Qv]I}]ş!>8S䏓A]E}ӢP%˂߸~(f,on&Eq J~Vv:S]+0mŧ1OAE)4f(#y e)>2rAYTP&YII9l7сI\ \k8N3u#hˋהzUVaog|c^?$mpЧϚ*q57ҝQZ\0.Bz+Qe'GǐcJ0h9;?v?~ u }g-9 {7˅yŃypS-U gnDy2#Izo6wNhAAR>FiKW|ȯQ2'' |sURǪvoM@ =`>З{$tS.um{"S{1qv #{/:vBoh5 칶åVrܫ6cעx.wQR;Њw<>}M_ `Ғl .9I&%w!OjسlARIG!g!15J ҝ~@~yQ ZX0ɞڶn7 qw;I.M~Je/j;k=9G)p#j4P/l Fn6?~[xFy\}JyFC5S,:ȃG <'<39K(L}/ݟ0p\bat/`lZYfkI>mq2-הI/"Ո#8鯟Iۗf' ʯ`Kyn]?Hck?O%n5哦~r/| f:q}٢T 9Gf۠_ԟ'ec^+u'hZqg.SdϨ>LJjqo2 <>)iuirnY(̽ %h8V\sӍ};YgJ䭱=5ƇN4|EY^>? f5p˶ulr<^'rfxR.X ٿY$bJK4nW}_/#跩0=Ojg1o%.,Rvd ;?P<{L|_rmSO8ҙY\h/}cI%W-DA%D~ ڧtv5]5}.K;/Ӻ|$Լ%?,ul(<zpzm? qL]=Np1]3AwHWfJxRw8fka%h4]~"~/Kr?]U3\8Z'ރU7~+OkqsZ*2wZN.8&EAO8ڋHSS<ŋqNN|5qoݵ.:,wSKԣ ᯓ~(_f.ĕ}\1Vk}QǶcw6n͎uEՎ٭Ǐy܌)/?9 +x2[Zjm|vz@nW߸2ky:z|+ >֟Pk'Ǩ@$g&|]xĚ]/Q':WVkY}Ϊ2m[|-|/Tq\ a}s=_<ʇ70O>Kݹ'Ow3oDڐϸE#T'cqiY+i_=~Q= P ߂>3-Ao:j=C +\[z&ѹr߆Q59sk'<-M }E(sөiIҺn[xkǯ Ljsz@nlKI/lɲgo~B>%u_䢯~~t3./1]1TNRCi]ͨQՔ_?}ꊜ'^Zt!#PϹHu%ܳP}Oٶ?oՉy]l0PY$a&.m^N}8J&Z [pZ'yKx?(&1O\}1{~&|b0uqĘ4MRI+I,D} 6Wƍm< a{47t>{=rtpZ x8z{![2~\};b5X}Iz]4}`n8Q^Zcc!>:8~~Kԇk1&⣣2jD;sG)8רOogn?SdK woCBs6_>v?ǩN5#4O8(WY%A-4⿃sK({skO#;!iov'o65+pse+4 $8Dx$4j  W ]aGE}+#u%YgpNμ*Gy9B|kW ]vê%rHzui49ݟz|Yh w% l#!aѷ"=Zq.+A,7~wwyHGMz3FZ p !`9gnĀVs _⤼ڨ7!K,}6}s^K>/;{ag0XJ[;-gҼ70ٓGoyo$sZ՚|:٠@.Q?Zh_ݛsaԹ+R?8V'6heؙȷN Ai@p=K};wԆc[~8;yvu R+~[ZtRJ{t<  zD7M㢨dIT̖O^zO=Gsت!n-q/\g}˂f*Qu};~^#G潲:\E/ 9J|r^?Y)}|JGyfgtmB3OxxsuR/5^V y"rlzȽ;LqCԏζqOo9e8hʷf;|]G7$M/,<璓@/Oƚړaϟ3\ ErEp9u/@Mzo ~>wi_5ps_#9#?g}2>.N҈~?쾇d4xV{_,xӣi/,c<_ͮ!.ɳ 5py E:cOCӺPw=%el{|f'~PzJrmT0 DW lK&o/ej%o5q 0 p),!)޿n&]5xy4젹\[vW;Ú-tn[A}M߰O9f0^k9#zD/|73d8[~a(/HRۃg~ z1z3i~멊cgShd1>C/_#՗M|~n֖77 W'~+-=zZLuV%NN8PDty 2G'_pS:#x0 .+QoN S TׅϗE>g^5o% SEG0^d׫U`x-8Oʿ~ (u0A={; )5<E>[?vE!Yw9 Vu>!":⽰ˢ`6ZL^:Ĭ8> |Kf7AȫUhY7~#m7(dMǦ![V3>{ av󖀾هشz;P>\M$< 8+&I6ަgVq!Ogd+O+Pn:g׹?-%4O <_NA?g3儬Oz]p_y/ [?\=Oz -l8fFR} Հ0ED|ᄸ~a,ػ)N/y_xׇۧ\_x9t.J~8oϱ[;06Jr{v2{BJwwM[Y@YByg/#5LIcv}A\ b|+NU$n}~nzY)_!RS=joӺ] m |Z~y@'zm7%ٸIݨ2:y,l,8q>l{.p[hLlE|׺'$2 :A CX9WG6j?Y zDi myN0 +zp3|Ur"7ABl߹w7oLM?́>N 5Y"}wnzȿYKUo:Osp[ȄcndOo}Y?25UxyNݘuzxN=0H+?b>1!`'U@ׇyb郷x>T/k$ =*Q'QvEut$ |߼W q̎) OgxeA/V]>.Y?o5 ǪlgjLϤ|t'RCŴ,?^T涭ɑyGK;Q_WV>t^MyIGq:lw4]{G>|I y|{f#%Za'5bw4ʣ q:AmsixbF œ:ɯ^ MXwt,zUv'ݵ,v#T{Ecˎ׿c<,Z6N}UH/5\RASQ {a7K|v#4o[˻vO'wN_cMoAl5Ѽ]+^d#dVFKuå1g~ Cغua>]\qz3IcwD|vYnlgIӡUa?/]Ӭy&5@/^I} 8q<1x^YMT~ĎS|ZyoΈj/ƇTW_dkЅ1OI\{LQv ?a^ϹrK.Kz\|{솥\;.ˬx\>g~|sWKxbZb= øzeZi6SGH^= H"R* ߑ̈y3)J[3J|va~luZ ! PC! Tp'qhf- s/~j;{xr)OjMZ#c ww >8^pX/^Eqѳ#>_: j YŷzbugK(_89~iYqQK,=Հ1+mO_2R>@R6ygd݊I۽xwm3dpYC~"m~0i}ե[=sRk7!G'PP.c]빯N Q^]SBpSꖳr8APϲ݈wN 'BնQSxGVȕyLjIs\QF.:wH ~9=> -yAMo/$n.hѽYuv\:aN:E9|J`o?‘Kd-UZl{ {Ot#;MA>}){3\2qt5X:jF|7}ϻWpםɭl'okCc=zzp,(8e5 .?nz[>U K{.@}<~|BŊۊ̨ϢJǍ_%*,)GC i{uf7~cܹzg1ex ?JD d>Q^Lg[b7:"<4Bj0yݎ ^s  n˜^V? v+)'N7:7E~oVCi=ZE_HuA~D,/9 t Ϳ>Jt_黄(N6ιPL:B+怯>+_A^:W1~곊8WR?Q[K%fU!ٳi_{9YGȁm_vsC KiSEؕ{KY4L3xW> TnV ?mLS yDZF떷IS3o>SV=+SjOo}N6 dJا৛.f^.ߎ8}"d-/3/nG!å[?n>{5ѹi r s|2X 2s`dyߴ:0IlyS(\%zGyq5tpa2q솜[3#V I=ܩw G.Fj.Hh1X Sib5=#vn-ɋDx?fKx n'0"jݧ}:tNEn 5ժ5 KlO˭i5}Qtө[RD=pX:6~)L;I+u3hHJ}ۀyO|MjGxxe'{ `$Kń/HޢA+ثԏܶeDAԏ^G8.{較go G&;|u?+w-s5 ?$Ϭ5&3!P^c"1o/z8I`DC\ݙ.NXI7嵇ιqi,gIwk/ 7"^JQNu$8Cu?ܟIy~ {G{h-] suXҌ:#P<[C6qj^}3,Eq-iGf%r5tϻ5q!Zga7(w(qՃ1~c)o1sglQ+8fqqȏϢ&\,:'@=U\ n+>D˾!ybx(GT_o^=w;+]e;G!Iڊv({yo{NKˊJFBU}l"e$;+2BD~~:Zp5x[ߍga>Z;i9GhyTP} 9OY׀S6*s9U&BNx=:jj☷ O6l] [Лu7r}2n/&{UU.M*Q0P23K+[p үbHF/}$@/9ٲVc/{g1HiMU?&+|㟓PdfKh{5k/Jg`M>pk\ODǚ#O3 )K/' I3K/*iX{NHgTGI?Un}2(&/? &$3xGNi)`)#qw gH78):5[0O)#vWQf%;'?`X mS$k4}\w >m:9p:WI{mgGv5uv-z>sܵolō57}7Oղx9}XבoQMƚ '}RȍS'I%7q9䦻V!3ϝ& it~rhvڧtT#:( TGy9O~! ڥ6OXz^A1UX^cg}$/B\~qnIg`'!v\gG_>x8mg{y>X$a]ӱn~^h/ !w6-bq6#=cz&Mz4>@ʮ>xر}}a(#+ sz,ʛMV=üٕ= 3Ǭr&h]M_4ѭIi@Ww.-o̤9ew}@ՌK_[ŚBX_Di#}!6^"}Z(BG>/Gn|g0JQ}۽2蛐S>uR\ܹͩ>r~ӥ?ahcs G nlJ+9H95;oN(qbyxNp|06𯘑JvZ-eX`ݙ/c>o#ک3^bޑc^+b] < : 8y7G0 YOmdg5(1]8պ1n(LuF'dغРG^PH{o}W$_ӱR\Mn%WL.xes, 9F%[9^R皘:PPIǺy.zr/'w6/pq 3zQl:ۗfsE!~o{?ۄ[bn{i@)mGǜx\ N;f_Cu)$VJ^]?SHN }.|''y9oQx?elw/%^x$l] F3Oy{o|+,2H`<ްl}(^ Fs>7D^xa6+Og208J@_9wRsA'S h+q[k 'fwSJctew<#:XZa ]}|l {w%?Do >V;-6 oYN~ 7>ژ էR޴Du+nLoc&[Px(o:QFĉ/s*ЗvIloyu=|\w84:a1Rtpٻ<|%cн~g~r{A[^Q]Ggt˲#|z<6%.ޢ8kX+2Wv: wO_#?6J`i9M WźxmDTЌ5bI J !7Ƃ_،ˣ̏u1+z7-I (ߺU-{fW0u{ψWbC~7;٫RФpÏT.z<ԌN5`~ֳsKN=|{!×n: }!K" Z3@)^]T~íZI=:Z<`9kb.Ph0{k:sb D` ǜ퇕BwXT)xФC}-맪i9qu-nU}WNvUѭ\|w{PMs6LDynޗ_#@Bǧ^x)u|~YL0%AZ1_MVP!S_w0˙JnBDx8;6`*""K !X{΍]9e6!.G(1E,ސ*?$~yZCۿS%yWeg F(rKHƦoߍI~. A=Jp#/>p۰D(B{c<M=dA:R<'wEi~*:{Ck&ѽzTscօ,{#N}vLދv)v^s=爗(JƾQE;,x? zz79bg! 3B)M'͛KAٱsiZi(] ϓ\`7ͤ8.V2hk<8kI;X9 լ?ƈ69<<4|a\g-yQDҫawzlמy(2埲Q(sm8~ds-^,:ҍ&!x<ɮy<7oսwYtֶF0vxV+_} 0q `klAq ֱQ.d/X 8"n-h [dus | @)# *(9MmsotS^kc Xm+ÁU/7hZkZLe'~+,}m:rwip||m/ yJ{%_Sk.c]͟vPa3!kү_PJg=Wӛ3s*g2~.їZ[庼Voqsl>˟_?z1u.c"GMwWRۃK Z~ әK,Í@BvX79/L8ݫYpQџcSW`iw:k_GA $_{L!>k }7voʄxD#y^O)OrmQ3ߌ LcNq}H#}~1( 8;+ٖy0xC_t.`?#o 9 RHM-uS<^R;eQPG`{p/<.!ЀBSk.i;Iy\7lp(y؛AxMܣE 26ȊKNDS@K/jWm)mJ)Ӿ8t6*ޗ^ue7 W>Cy ܚNI/L7|#$yI7.t?Əj,?*kƾb#/YSۅB.KYk{wcb'dv: LCv UY~*n|ŰV%,r,:.m#TsM ,w /? _3Cw6cdV! za8faTL`%ɭ1 Y3Np'8 ֙: rQ|.iTfk#fvk/~``z)3҃6)WQD̄jٸ7$1O5Uvb"=Ãs: .?$?I?!Z%7\ύ/PW3g2\<:9 nyjj{5e>i+ճ<+ x]'.=l^Wh#=\Ku dCɯ(Aۊ') a~ZʙTEBD:)~Ud?Lw&{;'QFӽc 6x{uo?׫p*oư9I; Gd3oXz Ef̱O~o0q {F6_-7v]ɤѥџ eZ`^p,ssO a=F-`dE/OA2#`4li! O~;w\{<x,OvktZWeW<ӱ2CJaS0ͳi)Gb9/i&O\ݖ˳S>r$/-/Uw~wQ\_$]qpi-<:+x1nVʧ<"=0u-߲v"~${ ;(Phmu>z">Ga;hNƋGu\-^e?e]f˩^Og)Y<"|/~ V! |,@tca_?Uyz: 0vW,+Nź-NKp(êwA'i<*OFeP8vL9񫚘j}9g; 9\a3??W!/,Dt!=J`'ߵ]5OR dYV8cz],EuڂoCnYVt&LO Y fMS0 ӹ@{FЦO(llLu÷?2._>!u70+ݲУ|R9 ~xtf [98YȁNI^N-qbJ}4̟A^̺iw'hv%L'Om>by5Vwc/Q} uWcK!WOmC;F$<:*F&1s7.S!r_'J~^{DyҘ\U6שl 7w5u[Hy{1ێM)43cDpi4, )٧]̃O]o8Σ ~71>o=&[ku\GhG]BJT>^S(NW0*ع|IlxU։QO+}7%i~#.У[D[nq߁}Y+(T9,Cuܲ׉1/wU9!\8s &?g)mz_J vA(q)C~,GEzOb=mRȮtJzp,wZCQ]`_A J]~|?} {(GĞ< =|mR <#>f--J[:KvET!J*3NxЋWJau"Ƽ~fd/u>szkN~=*  cM|1EVg~1Ke@O޸_y^b^=t}#w4@7Dxp /{=0> 6yty<9|zΫ$ tNq(W}]y!Gu+ ڞVxHOu]Jɖ?u !NmSm+|gvnm$yP~y+ɳԪe1$7e%);?m!Ox(nء'[" p}dڃ/(&d ?u](wdi3c0~pP=8挐+C(ى | P|3T^;oq u {ԬݡO|*Q pٔz$j1ӆE .aWK9M!w9ۖT;FW:<6RzaZsx# '1kys]szoT"tm*yJv^3w }:϶Sj-z.Ӥ:#d*JhkM ;ʐ[:v@/YʣHyKN?'asu^Հ]U>3\qa'F_{; nϴ߳1I,yGs>fWw , 8|3$YGq=[(/d"'޽G FmVotNy hm/K,˝@K{u\(\& vd#ƱGϝTހ@>cݠ-VT$PeZIW_ _zs|dUJ'ມ򇕴UӪCvaig;+ѽsN(b tFIkvS>6&{.4Drx6783rϗFxx-COgsyk(~G ~H[zXQ q}bn)s͐a<|kC?gOP}ڟIJtavbj>aWp!Tg۟C* Gbtٝf|nR% xBytJ>USmo߆5%3w94w3?RLfA% o>;Q^>M@*6uOCb5䊏x}_Lѯ\qxs3_-~;.q3Z+cƯXt6..+QK_[갛Q9pk)0𽅂7!n#J~5s*Xp5EcWt`m\FRV)/hY|V~W648_zR$&i㻠Gb;fZ#9N%_GvO|)$P/)ҁ禶X|HC䛛9b]=Y|ruRKK*~hMn>@>b@of>K>U)hL=kycF:_=--:thQ%J,앚 b Y m Y ytU,Q(S\u!|?d/Q܏;g ^6wS-j@q~AjAFp/~WuEK|&w<@T2 n_^[v648Ou>oG1w5c{ˏ^C,5$@ `xMA1MH2 [ڴ> 5p]OYwȱ%F:/Цv\ |ԸU =2߷\ςH}Es,Xp\sCN3ؽW>n((*O{vC`YW&нc 1 e x?MFe]Lɛu-@n[?=T8?0`H$I#=_/n5vc#g7a|;7fSȒ?WfLx'¸97swěOjO|Oż2ʷ'P?&mY:~5A-yE'ʆtϖ= N+ }lB !'j!e>30QyOl:W$B~73VC2?k%`N9y՛/-d),~/{kom>=nBXU,~}_oaA]gL,#_Ap@kV&C>̴ 26r3wzn=?NzGįL7ތQh*>X5< \_7,P_|V&oo!SX͒urQegPgh<_:OvB%.ޙ d%i^&CnS ] @;ޖAנ7Ww0/5`w؝Av{l:vO}5p |dr{Յ7F )[S|mIW kFؗON.om=qXNHS5Ji$=|Q9[Mz$ԩB/ S0͓/'XհLsο<*_v+ȏ ?4RD.oE-Ԕox_61~خXU7h]?ҬIQ'$YDPSiW9j{?o$ [z}n|t:Mv6yџlmߐ]5GҹyVi/ŝ©>,ӑo: a[} 9ǟпǤR1gq=g_KoZs!he;Z6" 뷟&sWֿ J((?A4?b>aҙ7Pp cBQ'x9W&? M\E1":SU\vb_zq:7Co n.O)Juòݔ-yUbSyK8OHH9syEPFI8Id.J~ {Ò]\(׸nձtq|/L!8TNa#HH}i?9r|=ƉMI;s6pb=WƇoh~+څ=wֳ؞*+o &9<=ITx_x (}ӑώGb]{Oɔ':lC-b6׻˕ଫ_\Ԯ۾CWaHבۋsIo)򽥸?/c>?7b˂)!%y9'mO,Rπ/}77_K'ÔsyHRe~U7<Nj]\rsxY? 7UV~O.fd`ؔ5B^r@G( 8vGŰ]x_| 5MC{v`|д?s_=wxGyl&ߠ!,'X7f迨~A?jN~qRGd9:["_)\aϷ1_f߂ ݸ̢7SД_ͥR~/E@X*?$ͤo~ )cɓ EWa:1FvϾJ {8g,C5%=wtolgj+wtLBvNv~ݟ{IuR1HcFq=FAJ]gpйK-3ZU0|4{Y/%|ξc 8t=Jfdu8ͽ|׸c)!Ƣ?~^l[B+ {r#_gx^vvv3ַ;̈́SGߕu1onQV.To]5,CAU7GXtO 2kYu31k/#g%-_.x?g YD&hJjlIC~'O*;/R 4}^(Y>3 wǽB'_nrx'_͏Y2z3v{Dw85|^5;ĩ\<1ӨkCl8wd%fho]w;u`=5ޫ%/S|յ'Op6KkoOǕVY/JV@GXL Y3Bz;}9<lXPN/=vccYwO5 /4XkXʳc0: 3KeE!#c!EtG=^ֱ2^+x]gl#ʗ'mɮ8fyLXJx_>=6$Ty殨-i_P[c/zg`}unmt%,;lM~Maq6$?ت͠[vϡ@7A/i_8[&^n;Q:{u'af, l6}3gĵ ~8T`Ly_k>w\LI),UmA>R>o{>}đCL$c3NQs7%?ř+)WQtz o t} _γG`]FW@k/*ۼ ͌Vl-wDFЙ:{h %&3dп֓{;!vEvә=_!_aanRUXͧ|7zKrNSzK7xㆯvLq:F9b_Np_Mv=װ/%x-GMs,@ %{aܤw߽(; sTcA>jM*i÷_%x>C<=Sı}s1xuh͙D j?ĦԈ47${) FOd{I:IΩ{pf򉮄,,/}_JaWvG7iٺXORϠ0{zE_wje] J5ȳyVB'%(_W6b6waùh3ׇ֜\|48ˣE~ x}+sy^b=g [RND!t -xnIf O4`=#2%ؿ,vYgk( h~~ FRw%@:xy$$лYwr+:GmwO^U㚇!?̺g3~|M2w^-ʂB'IEP_tU)Wh{/}x0$Lç_PHy#eлx뫞S?hɻ߈NI\]ﾶx\ WΞy`.Ry&响=Xsxy<}eG [͜Iydc 7Bx@IL~R]-ɯ*"0~kkC-aKB2VI!ПUʯAˮS${SVh҄W#(i|#_$yz;61wf?>f8δ[ÎTP G)?˕+컳^N38 ؔ͹Sޗ< %</@Uy7iw׎[ʎc^^6NNkGCj/&,IItj3~ |o2Ъf}?ҍq4Q|GWGn/ ;}U/!v%=DOʖaU7KƱZ#vC  /^'ŨbָS /eh{8ԫO=Oy{hTy$%O0l'8SܣQM*;ao]^ y#:8:;,8O䁗ɬI`e[l= 8v/[ z47(|=f20߸7jw$7yYl;Gw1stu‘w]@lS7~[CuS6&:OײVxO̎O+tn*!d& "'?A8sdˡ4 ?@`9?9&}0S>ObD 8X:;A*x)~0@<7?C1]je'r=OyoȀZD #9/- ¾cxw:X"aLomm5?=zD15O)/Q];.Ho9zK;/TѪݪG\81f#+{N9k0 #41Z-'"o7Fhkr)2OsC/{CD*3w9]2%8[̺d1LIG-6,waO 7QB݂ʧR=Ÿ%tٔ_5$ཨ9ٔTkdSCN5'i-z+K׹~0졸e+;7bJիHA\Ջy;tWײPN(_~rm;3?e5tK笁||Ζ`>V{7nNRרeͪYo"6>n̎`>_OTymNf&<񷵩N_*Ũ)'RwӱKEVi_ԏT>ݏh7]{擽fQtO▃^Yaq `(wBryZ;~/V)^3r$'̣\蠼ax04K+eXY$lG W{}d n-{" љMy'J_BdgHaUU'>&b[26RXXt婳yY+/z̟~Χ+D!OWU#@/,+{<0>JySG\^v*Ur76W LPV'CpѶO;o/'ĒL#cr71_Ӷ7Ho q\!z8 us~OqΫ_`?ۼ.xژǭ-~Nj ٿ]3<BzՉ_i֛ ?=o./aZo=啷z8_qYxn~}ދ._ѽĒo><mٕ\sJ 0VCrCJlR8(ui"O`l?Q9_ /~y$*bW8/'m+s͔aw!cϳ_}Űc2;5ɝC L7ir()Fkҏ%g"mG:D p * 3'evO Y2 O3)yZ:Mvvκ 3?lN'#ǕMyH5SO.2%S[Ӳz lܸg8gbyIasvdt<{BvM 먾e_XtVUa]wB.kٷXBO8gpog/OþoWV^`D͢fg^v. ylAZIGwsݽӒ&EKE;U~[{&{JQ!")Mw]u~t\:9:l#ԭڽm{͍A-_p/sJA[.R0ç70>Pt~ øj}ohOVzBgM=+\]-~{ae#zhU( ۑqp nZMI@u >¸/v~y}O%? m/)*]>`9k-Eg 'k@լ\-; l@;ĩhc(\}_sCdM79]HozQɰ߻i'sveѿB=^y Z/^c.KJ>}4}s9rZRcwi{|/޾>S_Sٙǯ@ ="5< }7ws8=Un(lP9k O4bȿ;],@[)Y>G㻺sHk'۝OxnQȇ׍JA] 8za&C6G 33]$܉ 7 w^\aӛC&o8'LZv}Mȏl9g= q}8uGb =ο_`' 5p>e.Oͣ0Y_{v]n:ȧw}(CA> .C=|O#0G%v2+8hm+*rQ/yoJ8 X&8[KxϞMGVf{1ǡAw ~^3jqsf.}jߺ[=x/c@mM =˭&B #ߠ#vxƾ 1[Ws&i۝,~C[τY>C|VK[~R:n%sc@Qxz=[?8Mn+z .b@X4)|$_wb.Ƶ@?i]uYG} ٶo6# `Cs %y1\h1lhGЏrnQȟT.hﲙ G;NWWW+ /~8, ΝM܉KLEWkԋY}8o Bt-P^g}q.%TsOӻ}SӓNenj|Ұ% P'42W*υrs_-{'7(Ϧ w]؟wxhU}Y@2!y+ϼ3mr=x]ժa<{>j_ЏmTQׯ_]o Tr=9ep\K<~'8> rxWHCǂNzD/.P֬.y/# 6Uj㏝^8'Q;zFUQu<'+9y'wGCF Y9Q05^{]s= PocOBlj.+N~ZjU񨬿dbg폕kP$d/A=m?$OcK+pk^D 6Vthd9+1m\ц֛󕱱2&YV}F'>qǩ%Џ?9 q(u!s6^}DR1ά\1IĒ}!R`nβ+QMz7pxA8X5}g΍`賜sk\@=sKZQCǾ=&/+^ ա}e K9qv !_]=mx=Bxd ki0?qr?7[*cܐ}&;(P%6ЍWqd=;HItk] gO⑆-+هK WƊy|OՊP/jOFPo}ɫrNg͜xC⣊g^}n-Ca2 rw6|7mGOߓ{.X-eSrxA\K\ypXן8S&KL>@"΋dhI^8kl5#6~)e,TS0o >^AOn :6 CįY!y*.sHZnmӁM p?Vd C׭%:a '>`ۿ<!N%(_;g?ox]BIuH{gaзn g<ȪlƵ2+x70}5 I:yk'_EkYH)FS>zyvtZi3729(I^{1c4'y_/=<gᾒޅs@}oԙ-˃=7~76aIR_|& t.9 W X\R}ܛѬ7L?( {ѝP"U% 1J\{jr,?JcרV]"UaZoCOa\uHO8ȗ%i>Ғa\ س9,5B;P' +g^?ԿĻ ~\5?c=l?&ೲB8!QsyҪevhUz1tpOʧl0/W3 .` O&5wj5Q#Ѓ:L!=nN`3unU6XIS fy{AsmƠ_?k&C? y3 GqPnjtdCM a`(8W^+;|ũza(9_6ׂ ~ݛ(q~;eY/. ?|M-12%0no7%?t (4vq\7T j/QsϫfP4~A<$1\!~!/Z&1KףvJ{V9[>EA|jO .zۦoEvvkj79 nxF8ߟ~~\{ r ph.6{(>ʣ/o [#.nN\ȷ0[Yqc `dz )On> ֳ}%cs߫ˁخRS1.cPHU3Mz~6ggId,{J`?Ȟ/ xǂ(hg˝z\{Uv9-XDwZ g@~|Y⢸,;z~R\od}xG2О7ܴEػ=I` 4_ˁ\oެ~>.V W=o;݊q=nY`7x~v ׁp(GgߋqpSWsȟ:ϗQK(.TRYvMr-.c7Wޛ\ 5ͩ@I:l}ڭ/ _ [ R:$3ɭ$G@K(<A{S|n;1ޫ \:2,ٔOYPYw+C8s?~ނқl\0On S5sѾ+0E_ÿ¥ʛr2<'ZB0=Sw5걼Y@1-Q70rEu]xY>Ѿ_?=h'EKx9xvsمm@olO[Bc}{Zݺ" g|N}ڊ V0f>q(C0G:KAo%yݭmОS#G% VH[3ko]ʁ~u4=W0[sHґ(ߑW/UHWmr ?j16}}i]2O xB>bZXY^W*x #9ʹqzww٧qSC6f~qezW~>:#_vzMn{]U߆6*}0~Wq㏖i@=dt늗 SAd/|ktⅻ0l#hwaܟ~>NfCK͘&7݇qy#UWC9(OjrGa@yNſv|x藎wip ny/ ?E U}3rCƳo^w jW E"Cny) Uwgu.y\0{>~)s] 8.]sҡ#oMh`(55eoq>N _N3ͩ*?+nEC=z91~яPo.Uw3ɑ _qOP`}wb"ߊ&J~+wvx=9ԩs@:zzs>]p~ЈFp7+'S/2Hse6|_0U{ ab@^=ݔh^~xA*'9v)=m7ꄄ:~0e!?~fAtqޅ90/rlU&@ͮ|zu/W#vDcx?ޞpIsZ&JEiWLn,yҝ4}`t q6f-vky{*_P!?of8|o^$ ֗B}8wތ|$NC2@ʾaec]o} &<BMl6υOd&xc_PqV=r nND 󫓰> ]ܸRy(<(薣PA*U!0nq5c+NUqnçr%E 'LbgoG~߁k///ͻ@x;A8ü3a^N6VIA;^Zs+0jnY*og0d l6GٹF2k3B[ 8A?%۩=yߒOTj"uXr%]~eQ๶w ߄B0_Y=AO&8uʻq[Wlv9Խc7.H#@K6`ϩ97 C~‡i^pNUwg(˸%B#?=\[> ?=>7kXZNYq?hG襸|aK`3\ɲaTW.?;5s}҅&|=j r2^ǧirNgA]߉~τmN>ϻU SџҠov[ x4pQR8yD!ߙ6SR0o}p ]qzM] odw~y]?nYĥƍcyVvg^^\bA9]#. ^QR|ozTw r/#K}>qX*q?Ǜ'}ٹ5sJ?Ǹ?BuS^#MUjiOx.q? w٩|пGz9@h*x_r{?O^]ZM g;+ Qe0?v k 8_I9_'wgf'x⎄z6?GZvV{jWM򴧯%zQNͺ7PGߡSw݁@g {>T,|굾ya<4|} O<Ϩv[S"Q/Jǵ\Vۀ}ْ̏A?Q5\7R;]Ckf;":`^{7}]x5y^_|1>Vʀ?+9XlrIW PlzV+Yz) ˵8[gm' (LdwO'%ΚsoL/Rm> ? 2acJP_>4L\:I9d&4SE&ߨs ڣ4ʫn xoqVg1.YqSʟ8[hUƲ6ySK{}$o>/]U:Uv·|G}\\ƹ;}w4>8:sR 5ix.ik+Pr!v=Y0* Km1BBNisaо3y!?Y 2B Oownt+wB0gjo_}fgl J3RB\GvQWwM~mw[ןTP"]T-NYC=j>+fj V$/. I).2b.';o@^29̌AL>?s}$MaryrQ= I}c(܇P$>rPo+/ң>cQjkxX'sfȿG}a( hGUy ?{̯~ nz 7~7.\v 1nI3Ox\Įm8+.ROh(od[ogP^x?OկbY݃vO<}7'3OI^ 1*{h _qzJ@=^ȻӿFݶ/xp}>߫JKA'[5H[ӇN~CK+mo,E{'~5I)4 cYUqiCҠ,{E8\ȡA(Hxi3 BIp<.u=VZ#0o/?a{w<vwFSön-<28x/e'#6k['~`1ꕲ~*gy5zy/V銫kS<ڷMkAɗA;{C`>ٸ'ymwU00[kJ>uUS !8_>n5,Yx­.x\2&0Lی*|T6%qNGVC~}遜VG]\Gq/mgy*NXƴrI8󛷼 M"(ĥr9B9'7p˛~z?Ggo:"-?0ۢj3ԗ֮ ,$a|W=møOce\A<`X6ɩMu_*M~pjcM¨Gv_g墍]b|$R~zR\8!^-kLAAԳA[' &9K:KաDwP'lrKPry7ouU(Sa&dC:?9teݥ +AJ?KB?uc ]IGM=>8da\k`O?K7q6+E:WfGMn= ./9k:x=ƍ],rc;q6!Ue|B׾%/yaɚ'נ#+x5=h`=c[H)(s(jY+{j`ܱNJuS{<.A٨⾟0idO*G.~u( k妷C0~*6jG=n(Gӊh_\ү{q};!wϑ}*+w. /$Fˮ4{/ W8(aw2 ]z?}d:Us$>"pP>eyi 4ΚV T!r#WyxL+x` LXj-?X̹(O9R)<͂^ (%rſt5~X&>w̗-N]W)|8M8]\,~O hّ#Fx.6$k{vs|׾r7Hv豰'q\q/ T顽/;` {>);;ߞx㒠P.0+OB!xo2Ŗ_5 oc Lo/{(j _ue:*x_z|Ѕ]`O Yx.bx[c;x.}vޓO:kO iZLf K?ς|uVby/]m_J¯;4 ~7ъ}={J\;Cqmo;M{o]~θ#s|'ᶃx?ky0ٝ20Ty r$|~o)}=~&tb:c#k3q+)ohL}<Ac~7q=\K s\loį'QЯu=,򷣻S[MMM^E,ყե?*AIvƷxK̚:`GFȩߵ- i?(Sn v~+`Vc}'wJУfQSo\rʞ W2vM Ǵ}u}!ysPz6CKrkw=|i<*qEѦ^5xlr*0{#7w>t#0]Inma~W{Kt|zw̸ :-Afю˩;7TM[^JM>7Bmȁm!hYOw[8xh"ȇɥc]P?/<^ cG; ⵩y04V ~Σ_ơEP6\ 5{@L0Aѧ'^7n;ȉoGc/Tݢj)S6>*E^ds¡-OdsF'caKѤC|{-Wnl*?^,xӞOag78]{M9q"ʊ-OlyU7Pǂl '';7hvAx|2s"K^]sh_u @cmq[$ȏΥPOS\v0u_u3.!:Lz6>I27<MO_x~M ?ƣ{g_MQG(/fܯޥӼt/}%X|F<48XR' μSy\0[#,h}+0~GN8:C{hyV IV*mPN_=WKRB¸)8Ca4γ5kgޣ.5G?Aa:/FX;̇wYU3^6[JŻaÐ)y \ܖ+:g6nlw j0s):{&a6%O?C}E9)K*{uJ絯hox= w4am~|Pњ:3?4|]gȼdƳ P'WVC>LvfBdKna?ݘq>+R&C<(iϸB=&:l^y$- _ή~$c2D@O,Ӈ|r鹼^ _`v(/AnV]-q~Q>6/+rkR%=AhG;nځV()]OcOH`>@$ʵ#^xT2xbxO׈py9h|9uqϭ <G4aS }v,i;:6-Y78O\k7B hwxo"72Px-1so\^{>nbKa1#b'ŕjr(]tbX2<)z# y)ӟ7L,=UM8ROsUa|Ϻ(E#%(vO}߾YHm?ÃỾ4qm} ^Q'e,{ 8$Xde\kI9ԃg ف;p:xfz)s/ȟ*l#o Fb}v鈀]qV83z, -Шg,VS3kw.~U j{u6wj\<4šGٟ,19ud?:* 5Q[dԹpp@=s?viXe6&p_0;,zJZqm^h+G}c463yLJq]P{uuprTyUp hC3f&v@PO?"lv:() r4 c2jb<[@n9Z}5;(kNw4U8C?,(}k?,~$8.ILWB9>|Hfnh&3:R^?Or68$ʭs>g﴾sNծB.lZͽ}L+qo` ȉJQN]P̸z1u')OFlu-<{k3صN[A>-7z-e$WxkV/G}z4fZ=ڛZq4rz5n%bY^B1AOM6vo Y;qK!?^|M%)'>*C{;5`_| 㩆Lr8̛gO>>`{?Zn: !4V:b?e rז<q1E`:k yeGԭ9n7|7Vk_ |=q/z-a 18룿ֳgnUOMRv;8˗ka7ۢbW({Eb O)%]m5z QXYk)|S:П!-/+9?53?2\kL\|7B?W x\wHmzqn\Q{ !ͩ6nU* w`'A]JDaί|vv_/|^ߡn{\yoW osBd?'w v{Ȣ/kXvx'<7zwrF-1FfC;_݄;%=)t0aoz|yۙ 9O~EX4⾃ k6.Vv n^ɩo<(2G*VuM ? c|g>x뺳KpʚU+^~ݰu_7ax?7AW_shW?}%eL]ȑ Gʯ۱YvB?!OGL2 . 9`6P5=xl?.cei?5[\KN `O?,R>Vizz)R)KX^2BJB+_e=U:(}]j՗_5(]˃67aq"LJןJX asL&lM Ml[(xC2V2ķt'mS )1*Nw!2Jw[Hح'= {U%3>gkAF8B@QzG! *?-)="v ۟?2Q"p=±Qď[M6JOM81p"' ~NM8"툿3 g2&~8(= \u¹#C|eJ/#\lI!'ލ{%є?~0)0q%~]c"|bOT WFT)Ok'J?pe!s?wRzb{16Q嵄|^ 'U_C鵍%~]-(p#'ĿiM[)7;%[U ~ ~.+Pz;3o3= ?%ܵ]A={$c_-\^&̑3N4#<8AljҀ_k~}o(r IhÙ>B0O]#>]_Cm)ݢuzM_W?Dl OL%^k{Ax}6aA >%4Jߔ@Xha"jJ[NX6߲[nP5’.&֋ėtK²˖_Θr㔮0 aE +_iV#v_M5kL$Fk=tvºL|@J7&lCبƮ7Cf #lnE|ķtc[#M)m5)^w'+Jw'첃f-=b{%+Gطyk9$~yXSz)?Ï?B)=rpT hUG?f" OBB?uS;(=`KqNx'᝗D?pif/ ~ J/:LXpgG=(E }y/M~pi C?(,ѕ%_F'Km܃įB駫%|vϞ!~97$|' G_C/~#Kńk_)jk=!~m*Pz {oDaZ)f[o{R-T[9(p{9aƈ/wQ?BP~pw6{$K d'hJ# bJ9k_l⿾Ho+ $~W1JAh'9yI-w1?s#!yJ|TJO  H8CM8ԟav#B8r6#eG1c ǖ?Θq(=+ԉ4B=Z@8Mp g$g!H ϾO9ms?^Mx|»ȕs(}t{kII/G #|$~V&|=#/'>^"c>!F?D1O%|ÉF+l$|·yҫ.v |_6%|7+LjUWSz(%T_(!pĿ6SMo?$K;-[&})Ýp's$p ᇧ wC{~&co)ׄn#W  f6U$,LmFی1]b_ o&6o3KJmf+)o32eE ˒K$<¬vŠfȿ(Qi Mxmfȿh֜NXیmo3: %GmFی~)%lB؈ی1o3f[ 6'6cAmƂی1mȿؐ%6cDa ao3fȿ͸%RCؕی7o3{$6uf|5 #6OmƟLkA9ɿ !6L8\p8o3ɿD B8L wp;o3 fɿ$NB8L*To3?8L8LLo3Ew$6Cm&L} ȿ)$6SIx;fvCmď𾅄OmҙK"6sao3e'5$|1o3ɿ͜T#|rp9 o3fN>E,f*ɿ͜'|Ao3Ufɿ\ZFRo3ɿ\&6s*k΄kɿԒNmނ v7ȿ4i 6ssȿ4MmN>Y-fi%6.J0CmL{m~@mfyOL^o3}* ?!6So3x>~Nmf ʄ_'ko3ɿͼ}F]:fޓ@mf85?!6%?7Bmfow o3?ɿ͌M7?f-.+JIsOd>Ov|Sh=czRuLNiԎ܉Aqө=;;:[tp^ϠvaC3w,3Ϣv5Aٴ1ǀ?c%{\$\Mܴ1o?_?䧃E|^\u,&Z/XI_Hձh u,#b%myPqrWdEY$ Q$8A9@BE$45$5%3 \|s=%2\"6sy|833<_#ΛſD"sXM8byK1M_Ĭ|sΫ92~V%q~ŢނF,ȷ\!*o2[9b }ox>28o@l`!iWA8 H/$?Nxxg7xz#qw?xWz$q;G-޽~?xgdD6#j&xO~$=x{Ga(z)Iw"ާ'?JF[x_+|6xH_~ Z?\8uF|P >h5~waj!#!K!C$J_&a.0z3PBp|x1><54GЫI)D5 ?2y??)?M&GѿIt|=L|{c$&CO']u!_ 7O' y!>^OM''n'>O 'I|$$e)T|2|i6F?(i7J~F>*~3~|&d~#Oxg[s%'C(\zGI|>/Wok~o|>I?)]/2ϊϦ /p2Sl%_/ڂ/ ?~S_sJ >V=D+W* ~}TF_ ~u$~u~ }y_K+k7ʺƯ__߈?W6o;P4m?XX:"_UY>:F,f+v!~G~ Ͳ3 Yvw?4wWI K?-{?}߷ ~k9`+All35ڈ?9=_{KW_\>\5r:GGGvқK<|-|3 =M ~]Nğgߚń|K ^U:;zx0}JŸ?&f/!}Ɵ_`^_.>_ߗK/ɿR\[@~=\_B[7?.e-vr۞sbO ?}ɿk[e݁gȽ{d=ooo8}NA^Aۓo܎ Hv C 0 ]<@w&v+/_o,??vW"^>BP+; Jsjo]o} ߖj;ߖjgoǞBI~{www8Bu2wbo:P_$ss5K_||WA|7vߍ} = =b=v{vbzMbzfǡL f|&|P|ߍ~;T?yk{77Z7ǿ7fك(xv!j"\ǛMWfE#ޜ݈2~D L~󯏟[X- JIebg^|ku&# eaflɷݏ늷a;٫(Vck'C CNYx'v-9̾E%ߥwĻwcGٿ(a`'KÇWGQ#=(R'{5"^xxQxov4{ޛ=Qg?8ŏao^Q~_DzQ}OLQ >(|m!wTkv<* ~<{: Ї`|:v>j}|8{ G e:đH@*r1>]4 ?}WQN|%vC*~HEſΎHżL~L|c-yx "He^'ھDvH*1 IM펟.I%ő >OޅOaRS-miԴ䧅6Ӛ vM*c=>}IeG~f^7[?)^JCssseԌݔzT |*5k~*5[OZ| 0_x?ݕ*/bR=/N놟>Kߍ/aJ%Ԃ䗶ƗNėVRea2\1Mv]|kEE ^sp ]yCݝm*reeB~飵zp{zlpxKg|}yvw;2r 4YY-N fHsw>Y?M ONӚM꒵Yf!q)x}Ǻ$dg={ך[<>0<[kI7`̲SV^ςm~&>U3Uϛb&:fPortfolio/data/SMALLCAP.rda0000644000176200001440000002502014254636366015210 0ustar liggesusersz?1Lm e*$2 D($TE cR33t?^{׵kx#j CFe: 5=tH_C0Apca )naj cw| Ds~~@[c$Ӯg|?(rY\P\4mJU{*23&337}M${͞ŻR-M5@zIf7[!Xtiw?,rH_r+ii'?IfJȽ@*W3#==@̦`MÇίky1˱V@7蕰 o1FK ߽){r>d8j>{Uu/ΣnxY.O#B׈q^6P[(i0Zc8Kox^Y¼f_ǧއ҄t#ꁕ|=P~Vu9G%=6][oU EngqFe=?_9Z-};fmR[/q~f@p3pcGT`z5Sw.;. Fw!1=A)z*Wb>7 j9(m{BsLx!ͥ^g7nyL g=@䦵^ve^‰-iv@ȕ3McDJSWhwRו ‡}Z@|3c DCi&6 d͢I[d4Hq5-@)c+}G ”a|_A(>@qt ߕzLik@a3Ԥo =hI [9y[T^-@URIiͭŵT0z9('fY"$,/c 0kZU&=\[Y?W(fGĝta|P:;U٣r<Db4r{` + ee<_;a?fWEw[V=vx#wL~v

7) "f=凴oIv=EL]!횫 1Zz>,2g>I9Kb.v@0)e=x)j {&֛D&e.Iy!X{]>/ܱc 4iDn;@s}d\{@x>f'P^N93r aZ'.7`σK}`iVU--)Gt څ+Ұ$:O&G颪22X:פ!B:6#9fD|芘Ϛ;!MŻ}qjLAVVE#:eJ1vqNL8+[mA>8`')bpd|ELCpi9b"dX/.L;!=s]KpClљ沝*AL:ɕ YU':9bո`fU#InjY; ܾ_ <x S & 0dzPg $]өL@cj% ~vt!/_BB/x'Ti\;@c$| Hɷl{YiV~3 ; YK PZjNw2$GXS ټF7Eiv|3>Gfec.,c{Uxr@fUE[ &A g˵퀧op- sIc`6A4}fkt%`7I?3weȴAE8)ض:{,K:fۙGa0>Pž`^]pE_mϡLX^ 35lQS,C܉𛣀690{R`ߥCͮV-=jǟELqY0;_ As`WaY4E;;GlYda*Qp{Dל㊊0/_^D_)-~*RaY~":K-i9l-4̆x%fGN!d'bIH0 NJf\됰D19 Clor~Hy?՟? 95-~s^GJ96!5OxN61CZUBՑ[7'f : ! +,*d ݿ!g*=\D CWpRW@s ѰmH$כ i?a~fM}̐Gҥ"7񬈉 4$8"w T(#M?즑b˻hdƭN[CJ[M2 G/ Tl!ӺO"鮌C=SIϓ8Ix:dy`HH+B;Lr0'hY_\>/v+?A@4K ×L|ƈ>P4KP*Tm֕5Ll*EP ŵ 0ϖ [@)->UM#ٽ0;8Dcrc9a RBK,-[ 4Pf<:ҁ-W_*R*S>咽e'~ⅉ;,9 ?za12â̂5.ݷ`1lklL8`Jo5,3',TС0> X]/ ӓsCϰ 0Wmʯz_^YAiM{ݐھqZ`0.ؼ R]k}kw`NV)D^E`p%$2D=v#StVuDOGr@Ռιrl{zeKfxEP|Bw˱j7cin/[$-or@('HqU%@HfH(Sa i`ya_>˻Ha@ݱn P{rd]Fm]!-=5IUf HZX/@{jQ?(@U* Fbda؎"G#&u@(F~m'ae/ P|t^()]Ÿeac5{GZLTp. 1wXa֧c!*_a 2=|TcZ2*0~xY4?zw fVʦY+,G}Dhw= ,.5*?jLde`u6XםŔY} /:2`-0nXf΋rp bMm\D sC]TpĐh0kK\RZ6%_Nfx0{%E$Ɉl bؔík.҃T'IVfDcuhGZ;.u G-_s#EӝሹxbI?,8JE\"ZGWh#YN_0 :DRlFwYsJHqB >#݃KD.S.1U3ꅥ$-5Zcs'${(Jޝ$gz0HL!ѥr/ڴ!$.>${ $\{`?z~p$27baV:P@4>u^nB. ejC"'D|T.:SdG':H%mdhGYf O^YaAnmXKgK^*g FGohqF:I WV"U(i:f,hBڠ*-W$".( 丱rnTʓ\&l E%Σݙ@_Ky q;$hNFasK0[p˳T~tK.xqD LB#^Dmݓ 0f90񈪖WJ׀7HÓiƜD#Q⮻W O? )Ӽ6`V{_47YҶ 058ff a.*+c۷z_)p+1@6X|mӚ]0pq qL[ld+ϣt́)\T}ԡ vX&l:=<*X; 9& X-Kwr˭OUa)z,ߡ?@$6|/K<ۄˀuM>0)(n[X` nwR@tw=acyCB)_@>NyU1,luF:Gg$xyTNzM_X*~fqED ^#Hq.ԁ.mn x,[1$+}Bzw~ooX]ĹTܶJȲ5}5UW:4Z\\:|1XbU دLAXP &^XJI}bL,Hn@MerBXӢ|:ONPٿ3t:y{\4lXq >] ~Ml$ٗ}_܎[0e|{3 0cy`BXx|㒾x`7|59 ߾0zYD[`r]TZ`*J8 CKֈ[\Njqo;f/#>O ĥgo%$jz8 %ۡ<=4trycW&#ARck&o Vm?U&Kq.}=bd[7n ~Щy7@4BO8}xU7"ڳ D&Ch>ɮg%DM\i)x@EƇ ]}E`q Wi$}pM'5"^G[axVUѷ }."ax>.0ݫ^f 3y #(E%bp^^zv\`}QFߎfa|-#[`=Tug̹%<@?iH|1Gٍ':KotXc[>+,E+wwdZ:ؗsXrNXłcLXRp7 伢b]6o 69ļ#{ZV7Ts;VP&ˑH̳M.vovv.3IneGӠÇ/;\Q0欹G:u=WԅʵaNW`] a| k~x!1`\{[`b8KvZ{z~=~ZB8/w8WijCjzꑷ^J> ҃ق*%@ji}.fEsr5M@ɸY .RճMg`)$K*Gm`V[ -=xM:v_88Y'~/. Z9 L?aqNj\X7~%!d,_7j<=Of/|ga50QVB.$lV SNS]bAU?;/rT/8۞r q`nj1zKDJQ NuR1JBG5ua `0'n S/'5c\1hH Xz(/Y1Թt(Ho=)v 8KQr 0vH„0Fnk-{LK=xN;]w$Ilo FX FwrřFlͦq{l`QAzwɵV[_ﻪ:4KNwI,Ϯ ὞]xg=gjJS#{ _t&rY2C&j9Ee}B1 V݄jwLżzb)XNz+i)Z^^0U@i#sW`vɵAa g[Z&['? 7; .fD !f_]1? u|i>YoL56;aG!ͤ@ s\9xMfb= >&GVɌ)a0s! ^Z* ;Āu[N ȷS8B6۬3ikOFJJ,;/Um}vgwQPJ۝dU> KG+mhy#a1,RveKɢpeܔG% .Nױz.].OWA.&^Eֻy#dz//O"/2M30Ȑ^_1b '"z7ǿ!6=Q+Z%\H[=`P^A[U0列~l[k}C M!r3)_cmGïLqy߰Q N 3?z#MG?PRfYsvvc[l3߲ tߘ`^KLƸhi7?7pV`>ٸGDvmڵ쿏w+lD*cs8=h@;Z wi2sQM) _nu tR:OS%=_o"u%@⌇sԸ8y?_[\LTTS߻OUFhI,Oj:_i oY|;o?AQ,/fPortfolio/data/GCCINDEX.rda0000644000176200001440000007222114254636366015205 0ustar liggesusersioTȔQdΘ!{=&BDL%e(C*$ST2!c~'yл׵s\<<K*TH"[4OBP;v# .zsB'2ξlGgk;~|Ԗ:[Ƽ;Sі1?\q}ē._~`lrʹe<7c5JyKet)ϖ1~'֢ݽ*76\m_cd_7&a>YߖQXh'Cڙ\OkM-6BL$ `ݚi_\ȼmW.t {\ {]^m?O{-v#AlIG۪iD#ԏ|?7~t 梓k{zZ[VpnKWKp_1{iQ~/-m&eplsGRpsG7؊Ÿ~-ωT^bLDDs3N֕y2X[%΋~ҊRQ½3M=q3SΤdˇOwi>_]GAۢ yd|[|;~GPn+֡Zt]d[+laT>NN<y]f;*'ou:kᑾb^~h;bŌ+w>׎n[s /5cve/e1?C?Lb_赪Kd0i⟉/;-q*>>,:M):h-Co>")97]mW+b޺Yݟ%?X_#Aߺݡ-yΟh|g~5zcsU[lc-[OXؚy[uGb1lLѽ󫭑-r:O4H4=;mȧ }ZǑC 8Ƿmq|gr3b"5Nyðu-RI+2@7Hv|c4?װZa=v_m~mB]y;-RD`Jv݄ӏy_\ZHKNn>92#m/ ov['Hk`9|Q'|M~G- zg.[.RlIG߉,߲q6O[XzY)}4R2q\{z1a'H,aT|1r)L>آE5[cӶX7>B5>^XKo.>C'[i0BOܙWklT`Z њ< γתϕf4@(6m72^~;|j/3y|O91>V ,N3'{E D'ٿqyDM2߁KZϟktM>y7WC ŀ1p4g?M|ghjW۰ xWu C;"t@޸7LTzMQ;7R>dk[|g>%w污?:0\6@(:)G0/ph- r Fhwk9[&6zx[ӾMӾDrT4[h-4[hFOE?xGn,|_,Ad6Zs%DemMWizYu-2/z}[uf?;2H|40A-śd~*0>V$y`x>, /PO[{wҿ;4⻑޴/mQ\-*1}Gh|b}E~shoAksѬ#뢁o:o'|x[4p7U%wNjK>8A^Oֻ7QNo@}POg?|։E&j7"Olsk0;G=%<^L|ΔW}3S3_;`zy FOM]n3¾"= ۲O?\ћg](w(AkUO.i7o7Ŝ3ɔc!ӏߣkx}i.O?ڟ^`1>irڝ|ĜKy=YHYꇅ38΢3ڡ=e ȹަ@@_cA|>3ڱv|`f1&;~fS/.s <[N9(gx.j27k^3̟߬j~?%kg-c|e[T;n`%:p#k hS`a=c4ޠ񱰐>sՓv|Ɖ22:={ -W_9a0C~zHϺMU]UrZ?YM7|$+_{/Yy6h0Z7Y/Q$vm| 5׸e5kCw@?̟/2 }Qf2gp ߇58qgώ?;v8qgώ?;v8qgˎQ~Cl;BکtcרJGol=wQSx?K6<H$ џEOhf7`q0v_ B/Z}eiotB_߳z˜]ƃxz㹢es{36wV= 4Ywif~ivQne| ø$ ]0g6*biߚVߊDUߕ6ヽ'3>q_LS}>a(y5~*D?gTnyK_F$_*+:C(W 鍃;i6ɳ{-ܭzE%ZIrsh):/1~[E79JuP-lZzTP7u y6T^=sAi3=z[t ג[#cHwU4ze'/ovk9Er{ =^9ѹ7_Fz=YDs.5ћu.$ZDF rzNGϫC/PBj|-Lž䳂Nz@Bwޫ5g\Ǩ}+OBٴ+ǵ>C%ŏԎp䳠m#}uD:pZ8T~łq[p1 :^?$?HVCK = ~Pb.bǺI瀂]|(|;^C.?jkj^õU( m/lv_oB풫Ce M;u]_o`-g>GJ6X|ߑKy뒧#YZEӡO}x>ϾQ7#? \~Wwj=Zwiܭk#oE*b6O1H}8׵"oc7)Q t} 0 'x 0uF_\{w7/? r /т 8kC{ `58Ug `ZcMѓ>޷ h-9;&)+7~cszV/WfoB?>U|)}ſ-2F=<Oމq,Sї6r `qI?~28.1ßC}< suss~\?~įo?+7-K{[~<=ISl)zDV c}SSD6?a>:~Id~_HyiP+#sxMPŒZ/121Oy/e.baB?zY'߫SkWwQSx;}wRN7Nz`f\'ߊ]gzPovG^Ǡ_\>knuw{|l};vK^o#ms% 8UbozG{C6'~,%tmpؗ]xE;ߏg(Mehc=Lz252?.1( uـuV`70a#dԀ^|>ve=|up0|xW=\vN/'1ð_@=7ijmДq3ø ]u1i-;y3ؚ%.,#ĸ58rF&lV;=_ >8f@ӟ0w3{ cD='xǾ<f]U@>ݜ瘯f=>w9`r8k %xc~kĸCw`78ߗPlc<5uӞyaka{yw?8;r~H!g{A,]l\u`Mc<玜 V%3 vUҲ ML h:6;7,Q|S\*6is}7[z?đ}!3sC3V7,B?Twg~geN ~bj̓A&i|_|=G?9.Hڿy܅_݀WГ`':sep~J06=^j_]M`/ ]V%cs:y;{nǪ^bǩ񊞐?QW֐>1~+e?B+##AFŸ3^ߔ?~_ /8hX8] Ώ~egN U-X~uWދnVKn)=ձFxX NC/ CcX8Lv0qL1t>L}x N ݇ke՟p|.fa8P!|!޷/d'eO6|}#Vzz j}2;&~ љc_k}bցp=}o0r/TWtiaE+jGz/D'1Ch0rHz$ZNz Z?]GGLi[#{XO JOHhY};0x; }sS,SnzM&QX#`tKZ1 Fa ;}F+DR{QM V.| %p!zQ ;#Ed85rWώV:6G_KR[_7܃CCsGleXa2(}F/K/Q FV`ovì.a#eO/E?!Sc#Mw3Oap1vY{ " "mW CTe࿻d,^rRv؇3عB*C _z]h,C WBy؏W{ï!}}y˫P7ۋ9͗9# \e4Ⱦw_0xjq⼞ƿ{-E~C<7gf7ggvqՓI[/"[4h὚}4N3Q3>8Zʛ{T 3~3y1ޮQU}Df_;4[5/gL<.ޛʚBjwq9Ts< i-~Ӗ 7#1lk\l0>)/!_!Bށ>$>G?Lt=_|#1]Gc."Nz [&ziuHt~E/> !o$^=XX88CM~j:oW'n:qToF\J~\:[8yiscl(y !nm3z'Kl:FsN_B[yd[tCѿ>O>}1x7zv?+^ qbD#of  "[@'ބ=^Ԉ<8j=Eї"7q S-|X T,|x!qnh|,=ގ?|Jk'?'nTMpmAՉ,Ocj_h 7#J{<--|Izp=DZ⤶2K梗04`*+}gRħҼE,Icث K7#^#ˌ]G/_c䫪(3tqJvinHd1O/9=;16 y#G_Uq+;Ōg<_E_\;!qG͕2 npr7²GGd nBcd'"y2 .jpoݫEg&&׊S,>d^:0!Fjx(jkx/ݾ3OŽ"E>k;Oc6v' |} lOa4Wm`O|;q]Ee٧W`2q;Yqp#_2o=ih7ĎK+wAǏ` #෇JbO;[S F"D/ dѱw4 9 bB| ,\]gKɿ:q$]ec*c 15MSt f~Xʟٙ'{uMaHM)K.pzX?%M^W0z;~ӝuCP䛘 oq_Ÿ4r9_Prs }g^rJ羙Vby6Y|oKͨN?rTnݲ&5c3_ъ~ñ||%^oj D߿XgivKwA9!;`9V޷I;s* yC]A4 [{OQ]r 5r;h-rE/KGrR,O~5hQ[/IW%kϱ=y?c_/JNu$_h0qu gئg`:[xXT,<$=L`7!`kћ!tQJ =RG^ ?R[!Q50 '7;~'8oǯq'8ߒ/78/YFp!~6z~7Oy/Ci'˽v_}FNC_g_s.vG耿:WG['J>1wI>A?*K5ZKˍ9_qї"L3+xY'ayjo]36ZwW-;ΣK{׿0~IE݈8ȽE7_"aN%oyvץ@N6!b_'S>%7vy~ĉ꿈Ͻ}?\{؃.rvKء"+2>x 7\N?¿>s ~Qį'q`LsIfoӻ''#-*{T#lҺ`ۈ᧜7弶R9?}we!YqD/̧v,m򿿅 oz ~]% $N> b/2J?%:m}ϛgׇg^'ͳtz9O74>ɇ $=N>f?v_zkP~+*+*~c=?u>G _ ꫡ=y5;B@3:ѕwԸzK.z'k=%!jGPI~YrtJ)mRjs CkT}֩}bTŝ/?g)%Βc1C:?;}j] >p魝ŷػO8T!}޷O<Ԧg%wOj[ѡA{i⳩S3E?Z) WR - &?)zLPϠqJPrTJH'8%}_סGF R^y"eה)j#Z uH.J!MNϧԠqq94;ORi>Ri>J.eүZIj?H"oTRKFI{T',;5׹8q2zdQ"iJ?%nZ')ʹR^RR^R;,lMA~O _ֹ3ߝRRCR뼗Z_ΏDO\CZ{.==DWTиY؊OQJ#7(կ-5qOk0G㑺~z]~E{oиRuL=#"80];5COjO Nh~jj5^6ѯֻ6GeQA먮z,ΜD)֫]j=ϸQSR/\yo֙$^w`͟{Q܍>m(c=z$gzi~>k>='ӷH RW6͛_)I}){L|=e4C\z2:?Q" c7?+K.r"KH^wwA^۲pSVjwAt)"+GWݻ5?3O%goyѱ笾<'5?R7ϳꏧ֭ZG?Oy O]+wok7ܽuj~J:_+\wEM8.I^v]\a=1kkiZϬt^u>>->jz2N5 8?5T=rCgO9%~yJ l ݶU=rnO8INvs;s5tOѺv(5Fuh=Xj}N\k5>j۵'Z{ZHn~}cX)_ $iC?Mճ[e>0>6bbY2)wj#m9AOV M;~)1!_< c0;ijg\ 79<=gd0`uX:/ɽ$At$٘⻇h^&~ NKXD&i>/z%L<W݃a Wo@ >Yww/Fx+/ގC? ʓ/i~crQSuEC2= o3cp6Y'zq&;hܜsqp7u"vӢ׏wGo+y59Ͻysk֡Y䔗8ǺGyl\!{ݮ:A p~#9yUr^պtꚂ޷z3,OQ_Wn:߻ʉ^\w!5d|P9֡.+#A#tMCVSOȗBOUW?zqӽ="E_g!xOj7]勊>S=5%WkM[!?w}4b:G毪}÷{`z Q{t ?_]]PMEE}~gwϼ#zUֱ~l yի g(hlm|U^C5 ǟ<">8Z&Uޣ~NO~ {Pc}Eo9g!aac֏?7,3w=4ZɜK~$wEszQ>% Oέ~@xT[`qkp_ě|"}=b-qEfGт8=9,``HyB׳<`0q1_)dF ^yVVzTnͳKg'^?TF~=!ҋ8^ z^h?wĹxZTE5/0Bs"Ap)vKگTop%AA&9o#y7DEsV.>fЗW|f䕛ٗ!xAIKkK?D&=CqL JFoz .rS\qi>\kn">n}µ[8ǵ?zo~3o!q6Nh3jq?osџc 7yk/_T{ 9G'鬥qďt3o;S{}m l_uoȟ7GI뎾?:8:r,wzW58 J_18?zd}JY&{1;D~W\|jص6B;|7cYеA|Π0s]?i|-<&9]?B_hŕ'\JO{uQ菪2?:ۣ/ogozq4âs;ědҼnG=KrWj{v?I-*LF:ש΢9?ԯ/M>'7/gsUԃ_gK!zOJR^֩֋<.㖠wx^{7}o"~m"j_-zw-}"xg|b}>8ivWMZt[@GKYdE)ZcSvOԾnkIzLA ZBokěHޯrwIxG\U]|BhRGeR}Y8O"yKKi~;yJ%rh}ѼpU ~0)ܣRLߴ&F[ѿojHSrP;>׹35}35Hh_ 8x9q !W5;ccN_$d+R} ˲GNݰ/v§OzSx{3Gw7ث/Ajg}/qξ&yωq81ߊ|6GqYnBurtWyijDobw|\7;zM𯮢o4D:| ugSv/E_GV%>3ER^$N!v''Ʈjh]5KsMu|/}[tYk;&t'dž֙+Q R}Y?G/?<\=$~=5iuu@X]rx; vPO+%ƒCz8.y1͓ rj?1'N_c:v_y vGnDz9~*ĉ?oT|ӌ8|ڒKXnZh}=tNp?vOj-#s3w|ʻs~/&;xp򼓰>dHwnr@4{5qE{Dgi|raI_]OW~/oB'7a4XT£/Zo5vP˸}Sc|?Fs'I/-ՓDQ׫y > Wg?'ЏZ/a+{8sqϊk5v9~uݙ?OceIjyngN~$'Q*?acV!Ω<~ig8O~s/5ޤЎ杼f5–G3tiiGcOO;h_py 7}@^m>]{6T'k'[ߚs;7~,sM?[m߁θ/0tњ&fcnN"o+SE|(x {%?EW FΨhW=lM zgy^ro>ܓQ܋'zw<ﱻѻqv3u]G>ĥZ : 'N sljG|Kc-ɤ]Ybp/-xt_ Aߚ8y A|W2徖_%obѷDN{d$I9w䥰H_͌ܗĽ?c5j;C/=g 䃺@(%ɛQ |wS2}zܣsPu(+o=2VאW)y؛ N+j2Î;KGWm y֖`=jv4pOq?ƞD>- #&.v8ܣ >x{d}o_wΆ\טij_X ɓo3ڀѯcܿkL?/p(<55њGޕ[Gog m%gV30x;;EA⒂`D V?CӒBS]"e ާk>ȏxϛhüO.H~` qHRBe%&o9?`Q]Gڢuyc$6  |$yG'2aղ{zo ޔ?HwyVp>Ϲ;pM~Xw{˜{YǮO,G\^bOjO)g{Q1ѹQуNzVzhy;u'o6vĊO+&:rY8ɟus08{Ae.C:8\ߎk"O I \{$蜋? [Q8!eI\Ny<S[ '9;Dqp Ё.Cع׫||Ka&`%WZ䟘k?]]KBc'ѹY݉+[/']bӏ]?4N[r!S[Uaá?/K\򓀞;'K9GO_͞~]=CU?%xKn}3?v'Lс$*uw#~d#!3Vg,J9?Aoqjw/k={~܎}rSGoG7 'v#d;oi2|WFsqM'񮠷;zx&kv |ԧg {?3ęt/_*!PZlz +_|'7(=܇"ᗸ{FiaWэݸqa"[$7r[˴-k?t0z;z+~̓w_{>E|9Ňӹ`x5pJ]Нw^f%}aTy#SZ~ ?YE"or?_!BhлEs3 >)0؏{mϠ٢(t^FHa6q@{3-?0t<(ͥo w^;5ីW8^ى o[^I#y{ȟ>Bjj^ߡ,zHZ͟GA_9g=@}H#2{p@c_O_)s=܃vGzR衝SO }i,. i1+$_A{W|?S܌LNV2/ (/$Gy{[ݎqh=Iwqy3nvS/ܿN8!dvsPz~p9%Or粟ͺSB'݅ڪ'½4ܓbm:3Ž"g0.&(aܓl%ȋvbPjM\*'x=}ǐSRaJ>>\Mw41^rMd5|u|u;&S5sop_b_ plI(qY/ڣ玡Io{{TK}sb|j_瞶)">>?Ν9kKݠ/'#Z[MM\ xb=1ivY@^cm}3!XiUU&n |!A{EY@ adJKעOܛ!QTDQ9"az3jG%yUQC&V_jicc %!*J1J~~o_~HNN%/$cB7k^jI`!~)v0/P $wA^)ڏ5 k|'5G_jo#z/S8g~ŜKǀ}{@rwy;zr6qT9vp~<^acSoǵ;v^=/p.{JN~[9Fܫ$ynq;0\y7hoJ^C?*$ߋ_za:ָ`i=,'xիؗ^e>&QՔ-^ֳ'E/OKszzT- = N.y}wvG}{|?x!M:G&ogg&$oG:+>/r?)͠o/O+ (-|{QoC\_C W}'z4q_O#<хwK&tϝ)J[Aؕ~Ew#{_yY_Y^;{[<ı{OǮ6 +q~uI!s1]=mGU~׋΃>| oOcDoռZ ]){ }WG|W;8߰K^+hzJzI?-b9G`}?x;A7ϼmE|0Ⱥz6o+y~+:+D}Or"wϪG;WLGw֥ƾᾷ4E}'Xzzq&Մ7{|ChWg۠+VW헾>Շ}z =Yq/s߄o[oӸ_ZA2~/ѕhXk?ۂ^$so]~D% @?HʋlG/#un"LW!Ѿh h3nMgC? 6h;c]ENOXMx?=@_0RrUY՟(.y>1|iK_+<#M>7NZ~#8z%5z.^<䃟}~K5>UAy roD]p{uSTBt t5[=zys{@w 뮷Pc--oz"2ЃuE?Fn|8 W;uz?};ƛH^# XCyt~c汈2zG`T✓%g!D;c0΋◱S~줟?.6[V|^ӸCQq|oN;qF4q?bXşc{)>o ~v@zz| C)Io{~4ѯ}&^}3%o_uwWsq<Y"c:dce cZwٗhB2,Y;DxffVy>:u^W։v!Kj\Ҽ+oѺ s~J5ΩE8qơ'j<_O(.7"xZgq53T :k|q?Vc?}L(hܧ=s1o0E{]&Oy TR=:F͛< G r:U6:_u'X9/>YfA/JS?GQA7gJU qH g/T"TC}5~Oqep\r? - -q弟 #7! yé$PsW! ^ߐ_8z} Y&LM' xOk<(F.>hߨW/N5B5nqm+^_h5{Yp? ǍT_By}i:qb)bm?oKRuzi9Cq榟]۞\h_G~qz@a5^]{1S.o?a4^qai$=R5MΪNGoKDwz44/LkWr55_׎WQ￢ME_!k4NHKGrJ}T60vH}ؠ})>WxվڢSLWo}m#Pa osgh~a/}$Qu~TnWJ);bw-V~~;^|2~KY^UW!|kҠ~MWX~z#yF:KCD WM#gsk.o5>Du*?N.EyÕsPu>njNy2DyX5Auzy[:?ޠp/:4?C?SgZ? U8I'x׳^zTK;#|{SHS]4RR߈dyj&Ͻ_PtQʻY|&ʳ)Jk݅ҪCSR?kjoҺy[kAZ뇶S]vگ-ӿeVl;OtU)?+__y;9O<7+d?WBNT?J_PFzjGuW֪c;٨"Fՙ>˺>뾡z*7._;WگDRzsvWWW~P"uWjkNX|Vj@ՓYծP]i}GK|Z3Ǻ5[:GZ:>q}Tw_t?q\|(ZN~Vݻd}}|jx{gr_8n3j}Z+ǩޱ;j< qjhcsӕvaIG'^yуfq1~ߪk7xwlp_k_U+zqhʣ+%8.8ߴN}l-SBo޼-ORWP]ƦޛF)Me:Lobu@Vkv%Zi)W|:_,UO˒3^G?ȸCەWcRObKFfe-F>p :.єQyF 1:s=k^~>c$%Xm[5^}͗ݩy){Zͯ::u,:jh?k,pS9Ok5#{gNtꞬ|Mk}o| ]tSއML 9X~*b䜳k9ۢ_b8O,&LN6;Of9?}`ρS>ls~?h0秿gclm ӘzfS]<“]ݝ<\]>> im7_v syn7Ja|~k3kFm|۽^輻1~g"#j#f#wU"nwX*={7~cG Y{F%#Glg }?Q=QQǻ㣻?z)>)D'E !>->W|L*;ďm &O}kB8?|59ďP >7o&[+^⓻Sl#ByĿs n(]6ǧSo7?hD>Wz&$|Z|L|9_ \x*qI5z$s'??Q G=>"BOO߉Sf@݂n=e3{3g߿"~V7|r|s61 =?ן7 ^? loo?o ojěh7k ov _|Y/777?/|EEEbEU$~1g|hE9|/~___"o%K—܃/e/mFCwǗ/;e7f× Ǘ_Koz+Wx+-Wz _,Wy_W|Wj [%oz|u?|k 5&~MO|?k3kש3_'Sį[_w *'~zQvG 78o 7څo\ĔMl7577Of2| [Xo[[-zoߦ÷[Aoouwhp߱>+$;w ;ke|WW|דn|=~@{Z{{ { .}l;߯/~*x놷[{liK!a!C[X2~x3p#~ ??zQ#YQѵg4~~;~);T;8Jx#-?:Ǐ!xxQx= ? ?q(~Iw;o;g]]{u--~rO)+?ޭ m)/{t{,{>{CzCVC?>#k7?>~ 6~asB"]/n__|"~_:4 嵈'S+݈22~+~I_Sf~Qok- ~~=~_^>߰7o܂=7o^~wߺ ~[7K ~ ~"4ďhGj݂{{*~_>oK.,DďrL1#G\G#GG'~|~#  b(ɭ?ld$~lo|Z|[ď[{?z>~1't','<ğI%6!wZ!~\|M&|./|'ĿXgųK5񗭉9*UW_=VmZĿQ c![ňk4>|ra|H|06 g3|폿=^Sǧ?J.?ZHGiii#VAǷO6%S#uFg^~l$sU '3ՈOſ3֙o33&3&~%>yUY??8᳷$kf|}G]]O&7~wxxWfS.ś=/_h> =śSH ||d|fb__*ޢ_|_/1 _"oy%kKN×Ǘ—BSce*˸N$~cre$~ c+W2'~J &~*v‰_-ooooջ㫯W_բ=Sp S92=AmbK8͡Gg?fy#{nzI_" ǹ<$wp[-eh=ݺϘ c=xة9Ӏa7;{릍lM6Mqk13;}fk L/l?v_> w4!9fPortfolio/data/SPISECTOR.rda0000644000176200001440000022261414254636366015377 0ustar liggesusersduee0~RJSi )AFCafs=ĽCw"HJwIK#H҈1{>O=wywYfmٿ}Ϭ̲wfgݶs-uYf}Yf٧91f>?Z<~G?y7;uLٝ1wh6ܣS[й[Хkom4~fop5:o)o:{.hd?.jkпN<7~V/>k0OΌ9~{'ݜ57W]<Sn9V\i6ƫCۜo|p4(v<_4kwb\ϊqo}^>^ ~oyz4w.I_4/m=[c\oF9=gGW tF?~{ܭ|_,ʷ#~[V߳ޚjUpСuvֵ_yoз7x9tkKwEg:ϋY*ڟ\<8vSn|Z|ʭ[{ |Zܺ~[Goy#_\J?㟔' g7m|ox~iJot]S_}>Fw/Ǡ$㛉_XnVڭ{b6f/e?}p|7.u:ND7mk-e_|/gʯ |_o7$|v8l]*mNG[ˁA̎Zf]fpi3gsG%K Z~R;k$瞲j\ʾu?=ԏ> G;è__+繓c[s+s;JGƊU˫f>*7r.z9ah1hx52s߯ofG;+k__mrvNVnq)yxwqܾ#_9x9ިHcq^8<\sH*X'|V_6ƭv1OErЧǀfD'c^un_7Wrg#{*~'ι;o\]ς^^w\-pUu7opV V'Dտ:ϮYGu[c-1?*(W~3-R<#+~t-EفWq_,3POက8kУx5o(_Z< ~BwgiKiCS+xݣb|KՀ@U^^>ơ~ʵ_OmB{<;<}>cy΃o^e倣{|Ot\hr\IgA_怿13m^9>UWA w=ڽH=ʬz+|h$8*tlK3躚qYTrq;PK{ygi_j?gXJ?5y~F?<=;Fu x;Iuy.|^z6}͕wޭvбJQ= 7XwK >r^һu\߫emX'fw,s>0ߊl ~a{,-~o~.Suamt+^feYmZP{*?ga?i< <'$Wto3z(蒷G.J_9~z'7ȅW/sC TvNB!Rx@usx׀pP3ikyޛ<~ }f9qh or/EsZz>Tb?? nG\>m|dXWC1^}hw|:7EC?#Z)oVZA>W;r ۽sDޭt~zb[4^Gms4'yciH. ݡ>緡uy^}a<׆o Y_ǿK/e) d8w烾9;Y/Al+]-ֵR]3A,yx?;?f7 ˼u0Qf3\pe:1?z 9Q?/+kg͛I?q^^nÀ'G9Jn8Wz?;Ŀǧ~\wSa~c?tɑTߺ4xR_껁_aG᷁wzg[|-tNX9`Ĺ\+}p~]D{W(w~ BpZЭ[80]a< x6}Fsy]a?٧ 3}/«^@U899ÚFVykzs_/CXx8I::Ew;GϣzV{G;UqW\=.=ݻK7 ~-'-noHM]\^sr^U~ZϋϷݜgwnУ4ͽnvx/Ư2}NyrPzڽ{Avʳu1Ƒ<>t!WZf#7?3~~ 1߽LPH_"|zq-/W7}Ky{t߈<^5zYgf3%n|7~c7"X8ƳOJ=|J=K '(c1KC^ zxuSt_/b<ӢyXdS|,+>dkXϊ:- M*vqB龏C].:VP? nRVO+GoRzX{DVt+>oƋQWLrzGù7jlp:5 e}zt^k^}M9DV"/(΃6nZzxY5nO4C+gIN𵿗wNN 﫬7u=N}TZw}zR(wRpޢ;ԧ)|mߎr9EWqlC9urrR^)>b}L'ӟ oG5Π䷋.G/99۞Ku"/_|O/:*`OT]{OӷLgVB7Bcw'7pޮzvgu>_WaV~^G菷fI/_ێ^ܫv,15X=HOVDoyQsW_O-߯M3jecxWGg=W?^fb_j]bQv;| }e7@O?itnW v{ qZ hл5O69?cWjߪ#/drcԫrO=|Ԡ/K tiChڵ'5c&5fI ޷J~]msvCG;97!wlNdg2I)1.Mc~ |v-Gs{s;zڿ[Zgxه+l~^mxo-pRn迵K+M|gZQ߰G;=P۪k|hEۚlU㩠Wngx;;M+sbl_ޕ {swkaxĎ%D?բQ^i{}x>*kަAAʯ*O?G;~;r~U#TmGWc<B~+Q>~!ƹn >Nl,f5 U1Y9,Y?H_Ed7YhoKrh11WWz' :%Qw99NYcKqLN~iyow|nJR=ظГWaw|d>-#'jOknZwX^y=;7oy#y)>[<mv_o߃|>2m;m Gij~]I9%zn6/?GUxa|Tf?YK{ %#zdXw}C}Qϫ~gg͛rޝ9w~cY.YscpG=:'EmٙuQ"utnӝ5utqt ~|1읻ֳޗq<wysDݟ跻W̋.9cw xu飻G__A`xu}yay pEyx}p(&ϧCp:ec\ sQWљܳ$:ܤ{]wo;ށA{^ΩwrCATϭN=z{Ӂw|gW:>3? 9qF <1>^Ͽ?g}xi;+ٯ{ɏs?!4:;w؃~O9u5۳K<;}It?vҳ9#:7eGuY=aEܿ_Qnyx~r_?&1oWțܷi/9y:5ֿ֓% WHg{zXOI6ACSJfA{{{ާ8. O=E<=>s緘\GOܻggA9Svqo@ Ƅd~t?%GvnTyf+>:-9/Wuvmz6{v?϶ |+֣i<֢Wn7i-G&gi}=?8nkON>۴o+ƅPmOڻ];O{>!󃼨kpNQ]HR;]}RumzTW]ufԯt*c]au,);ž{P/_ݗ߭b\ҫշUv:1>՝ᓶgnG~^ Wv~_,.L{ޓ`޿FQ[׏x55Qg5~O5r5˚~;_;v Е\>{|Ϡz:^^Lۡ'/zY߻A|_{1j3Џ]a Ϣw>W?xE䞵N=Ǵkzވv5y~~>{I\{T_Qω>.^E=V}sjr9|7ϙeOZ>e2R{e;_UٓVW'Ưz;~ ՟~rw<:Ygk<2dO~µS+-O/ ;=e}t}ImG[͆N'07F::$NRnuG_Uv 9Ԏ}spվכ7Ou+͇?{c6 qm,k/R |Mנokj_]~g'\5qw:oаN5~׸ƥ qDA‡vcm{{_v%g7]rh5A[7_]_s?j^Kcq(ؙT0oS}5Rx'#VwZ^4/΃9~ÿƾvkK ;uuugaD3dO ɗ .CEyqCC*_qͳ̳͋W>-QPt>-Sa͏8^9E^`p^q,׳{/ǞxSy]=-ыĉ*..Fv|@С;r}IL 9kAҒ)9WKπhr]GLgM)>9DXn-S;92RgT0 deo̧RСL~S_QnGʏ\ϛbi\+ZĉH*Uè-蹭QZ\'{9qm}6}w ߤJ=|٣~_<8'7sb~{sn#Ov5t|wN}ys=Z¾9{Բ׶ű3Uj֟e'ǭjnjTvrX~+N-'}]g=uSٵA3ݛN x**U2,VK{\;;ʦW?(9U|'Ƶ-Ͽ%~~=mah^[x?d_OAwV?hyr?xC숇։z ɑψǸ @3ʬxeq̺Ofqecfsd7^VA u(8ds{{ה[6}V~rsGaAܶQ>sΣ_+o_]Gy1'ඞd{-?ۃrRdw e&!{@,ޠw8Gn1J7:[qS?4:= \\4K/gD? O >5+INm/u;'NtN{.|!'A ukr?gO85y}eQo;[WWqnHCy 9CAy>}4 Do.b-/h^\W2_&x;H7ȏ|P4x!CK~ziq<kVo:5.vȽpJ vwq2+:+)7FOvq9  [(8ħbo<p^|<̳[7*-y)/~Q?da>燭 ɛUszSƭcC1ɫ k%r9|x%EтY^Oq~v*z_t~*Vt~y'[=L(虊׀s;â8Cy,.ɳ )_@nUg Fg sA|y`5㰁{Wx}:O3.._PEUxſh^kSDQ.M$dQg)OV< yNhVV|oV9O]WxqCb_oyrڕ{]e;wJS^ߟWzr+q2+D*9ߐc9'T[T&:A}+͠禍k㨈#]?UĥM4aFAE\Hе%/BPr:9;~Ǩw2VاU}"W_ӯq6?R"|[䎟7^4j-M=T5j[r}jG<Κ^Ưέn_8cQs/|ZG.,C<\Qg~:;|VD,>z~Otz< t/ ҇;i4۪Q~ٵ;>'w&WKO^Qznscw\%VS^k,K|*{o9kG&tU|etm~7U#WI0v]nG#WgF_Vo6h~?j K_O^ίn#Y<-6^c$tC\\9X.nQ|Aw֛݋|N3ӺWvٳ46gWA7[b vS7ᫀW״5On:6?m.tkn`5)iN -MrA A#=ּgK\֯|_?Ӛ:(j{gOw=u'Hz,-`rrOnGN Z=[ /}m덠_h#~ -چwOJٻ|گE; {dS^O5dL% z?0v:?Ad^/KIxɼ>Yͻx M2.OM1way}~SxNLv:V-b%{%#ق۟6[A?;9_ o|'~{R;^m<><[KWV0.xvZZ;j_7<~_f*U܆Ņn-4UZE[߭%~{M}zs"/ݎ8tiyK+3~oCookb޳׵;|9m3mv_{EmڿN?ԾҶœlOnlIy]<[Q<ʚ7.$) ҄|Y ơCY1_v6R~ .^V\k@gv蔔:|1ΝzзZxuȹ숺?}bJK>=} W_a<{֙ޣBk!x{t}ROV׹g>tGWyo\3:5Wgwa9].b|}sż4&\D4 y}xkXaxkMp6t]ѰfûE{=6,zn:!o_~>? sGu~8G9r;^s=p͡93L1,oړO/oIMpy7cg4|F;yW>l铇WO}xrꗟ.x{\{iog34r?^}_A?|mccW =vC==yM{]!=.+/={{:|:?`JjO*'Do~}4z) 鿉^>qG7>XOٵt~`Kײ*yd6ܗQy|}X-phtm܎2/nN:Ǟqx}5:OAayŹov;<ݎ@9у=Űuexfxp4^q>={3t$WO.y_ b6||+Cs<#oD#F3OωvG]FۇɇGSfd0)O>7[3#)Lr'vgndRȼ>7o^̮$=cBԛ}o໙ӌ|I/s8gp̴a)?LEq\w]mur-^w;x=zUy&?ywdiz?Ӕxt=G_<g{/ww:O<+F2,<鵜co z8['3;z[EυQw~|7E= G~~yL{y zO?{{Pk-qvխՌ3{JHBkyW|M͇#?&}{Cgg\zNOu`8uyoZ[X~In嫳#L;8%#+~\o{C?Yej֣~Qz/-jW[W叫3ï]X}58CkoY;\OR ~B5~85y꫃gqմv|&XHD_]>P=vH/;:U}sk4]KWjCOQj%jj֯f5kiv5/kzǨŮ>vE+U[+SaJۢQ;1wE\܊_VϭSzEF ف^=P߶$@Y81~/Le/cbqoܤ|Y[v̮<{-ih ~Y˧%7p/|/)WI|/A޻{a0UgR[-?tVVy ;1>hG|~6χ 4$~CCy'Gn^k p ,=H^8h}O0ȾdPc_8h]gyнxPAF;g5>:P?'>anwBsYvY|Tg/vz3 Л  X_ggpNgg:{O{4N 9F.*}ʫ0}N'ٳOcW9mi)|)ƯhxX3 fLwaƈ}h@cF8Yrmrv6;;1ʇ]#ɲϒeě:đmV_?^]6e22wĢWe'4缔s˱CYsu9q@,+/ivEͣQEౠ=O&+.u'sG9o)Nzb3 Ɂ_e'g=d0Kw"/k?12WqdwYer7]ϥOt|=B'vYzYvYvټ >w?8s9OsqZ]ܸxDcrӮL9.oDN%%wZjoQɥ~N8(iyC;ߧ>9e89/dﶟ,s?33+Iֹct^ۇ23錼r ? t=/##oxXf5qyohaf`uiMSq}~r8+SWv\O&{;m|=ڔ|?4̧ܩ1nS5GO14ymq:{)S[?q|SO?4ɔ_4&;oOvD&~7q}&ȧ59o";4<bG%m,yX~UcgG3>=A~F{'ǎc{۸wc/{ݻ{xq'cOxx~x@0_l Ms;IƸL|=ڙTퟓc,c|&O"GhN$gD7$I;p}&^d<忝؎r}yxُNVѝ'Ǣ7AjG\ 'wy1>]Ţ8WƝgt/~Ec=G0N HN7Qޒ+y':Mw1ln࡯pG C&X?&.|~7&🜸~^ [IM8iu@I~'=^jIO߯yw?x$Mb3iCo9I|IM"ir;i2dNn2#OÓɅ'[/'L֥if=v)O]>-/ϩǩLŷSWN]2_+{+~v߸~N_rM7ߧN8M5t8^s!ߙT9ݺ;]:M7ߦny$otiN_j)LgstgPN?w_qt/i}Ʈo3g7/~w9 5Zqo6rtNXع׾3?Ag,iݙ31AS13># _o2O7| tqq:yw_cwc@q3 ܐG')>"7v16{x5WrY+K@eȿ?q3^ng2eu5_: ~?ȁ;vݫYœ!L3᷒ =9w7s͛B] /8sI& ]mhOq!Rw=>=U /RϐPy2Kxm =Y/Î>Ư[F;te#e<8gvnʳlύs(q|e/d4zݝEY^yY3،}KZ?-w o?t7?Ȉgyw372*t`G/6/-ut]̍M祼5y2XeSCOiO^Dߔ]P^Rs^ʈ~[y|w6miᇞ¸ܔ3R$܋v|=>CNg@7z { 9^}_F)s?xH d =c>8#nwFTN9zo9㾕y}{3͙gϮ/'K>݈Waz Rlȕ7Ϟߓ˗w rey mfޭKfJ.,CN<z(׳#$G >cǑY?rN~EW9Fv}^Oq/qyω{^G#kϹgr{rFb$f<8|ppqzIy=l_b=+~NNLovqM|q8o"'s''OQqG|8xsvOgvSz砼$ʸ&< 8(GGE=C ]C>7>bw0(萸,q;9ܐjgh zuqȇ!y衇r^r(|q?S'^ãg6>yy>D?sJA]Ux= bz_OvGc.cE4E씋Ek앜 Ƌ%ŗEvEr?_ic_DnT߿оvӔb*z-rcS~)YƅrFKM_>5.Кjy;h}{"z]-q{Ǩ^._;Ҿ>mrkOk-^F@4mGlonO x탎 OruބK"erMЯ%G~g#߿ϝA'֓ޤz;{W"ܖ>o+2ή_ ^Dvu8wt<iO)wKA~{Н}.^g跳N|O!'A^3N}k z&~VЧT1/:xvuƃYG|_Îeѕ?;-ƹ 1]q욻NnԕO\myܓ?w{Փ/0O*|ߧ~wÀ/cEA> x9wxb7<54|HйDݟ^;<<_е<ާ:,0an w w񁆭?;wm#wz^x)#F&+~?W9B^5 / r4{a>;>?a~>;߾|=zMO>>Aݩ}qu_O4NG\Ai//}_sz}qiW0GC祃Kgd.n}D\͌+ 10b]9໑c;G6WhP;]LofnlsAǑA|0J㭐 3G^~7z',`@ 4|yU]}>=Q?pco#ֿLۻ:N_;z =>v˓I~>'@}x{ѻ|%.~ϝkKط;v;ΆA__p}t\ѱoo?'~)>}o{ lF?َ=!|"Cs8yC;ӎ|~y ;-u vͻGz]z箼]gUȍ;w襺tŇ:v ۧo2 Gi\5z-O/|uh߹ys|>O'3هnOׯq?f^e >~֯|X?_7`!/]%zgk|n3/مt:q6;֍o4>w18NGQIA\0~:<:h;q\r=vop#I~ߣ:uM^e\I'vɾ~O<և|9%Te+g5Jm3Kkmt3{h^;{MD?-z7M:σ W2TXKRl1A^X|o4~=ȗy\GC=I^&?_ٚ+5~еȏjiuY/ S|/bSGB^Us[5?1tͥ=`9ɳ^%w6N[g'TZaOYnJ>}@c;ѐ.l5?Di\xyqs'x?kGwKրwk78g$j&'K$_ؿo$<+?~"ϛh+we<"LKտC{$K~ξF,go7%J&ωu4yy[YJ1~aOÙ$U?jN.K?0D:rnJqpk^c%];zMB 7Ӟc}md&B>s>_gGxF/ɺk*_ݹ8=yjiߖ-C'7Ȼ~Q?Y߹<>O&9N2k*xqDrutS>Ȅ;qMĿN]u8Hyb$O $_ߴ󊧼 YpY'ģ?Yec]vZg~y\H~kЇv%8ƽD[ TvzG^Cљᱏ﫣r|_\%/LG܈wo1!/O7.W%/C8w~޹~O|;au|*aG_z_:6:!Oh=e[OwLM;9/:Wۂg+_N@m"C qeۃE-zVEkӬ'ŷ+>^(X!t[^%[#oB_n}@G3xկyo9x׵C⦶oU=~΢xeh:.~Rešhio\rnk !.U*t\w.tNצw<7/zw/"{W˥.8V`E;j)ja[?:eU@=x}vCaУϭqdoZKM:Q!gSk[<-7hrӴ7ܲKZ*'S|?l|'36 57;ch%n*wɯݔvfay|L)zٓI^y_rg~3@+jkۋT\^\šMß&?[gR?\yw[}UVTǿ2ou}b*M8#ykC憞vkhlА?;?x\L Zý?Ύ1}+ƏtT/"{G]FϺd.?K\:/kw=3ͻ,~GENfs ̯9%g&=iet-ʉ\{{e 6V}E^8K𝼴1\d7 :61lC|%EݽK(//H: ~ ~FY6>~zR㿴߸oN? ?jZ]=f˨a_gaۺHyO}ſ' 2?e+w7;)ѝz[k_wǯ;8Vۡѻ4bMW'ɚ/3<|㵖'}Dw^Ex~E54^'~qić4tPtƤtO#z|V?(/^KunWs1{A{C# s_}/?)du~=_΅ow{I/|O|l^> De"_2{r:c]O ʱ3MN~S<>$h3Ļi)O(o72.k_u}8]<<ݩH{' 6{ }ˠѸ'$ЍsbHN4nKj'y}J }~OVm-J3ۀH@-+ G3A{&%3')9Q \)>Br f={7$_I>*ϟ.Eot*Db]HRe,al_dy _,)$H$DQ@ "J A9.3s훻o;qwfWA@@@D| d ,Q~_]UpԩS|?u>}N>j=Hvu:[#]f}=?wi=}/^R'Rvzh]/Vqdwm']9OΖ_~Ѻ,M;?BK U gxf_P;]*.?Eg9|{?"io_P kwpzq |.B G=p{^uo; .{'|wwؓwP=>8zcOt!^UwoW]}];荺7Xwq jout׺ޚ/+ƥ; Yq}o[3?z{/p;so>'^q<}EHeN}Av=xE|գݼ鹯}+?73w^ÏcO\#_C+?\+354U8 =vڹ0g.uEy?nx-+˺9 .</G?CIӷ_?z3edV 75L?=| l7]<1$~3bG?M#ʿqb5|Hq_/~?#Ի]#p:G6Rr#;'^;,~A~GihH[;GJYFGۇo8ew ^Mzs!ᕃ ē_??rgCϒ牡0C윇 s^zW ~կй=ꑋ7=?|L~Y|y;yOFҎ{M\r1*<?otP(<:6Ч33/~t~tPnly{9z~C18c@ǎ |;(a <1c? rऎN;{>??#?5ᝌo"c| go'9g9N8.N){?#;x0㋄qG}0cp^ 8̼{E8z|0ng7f9;,vZN|mBq</%/^{1e_ra~j8?Yų5.|@yf;k~8epfmڝ$এO,vv t:"7kPnցaf(5 ,qQfO6wv|>r6}f(7e6{]g~c}C'6 |p?7 >~bfϯ?]lrdg6gz={od9qho0>:&[=㞛 'S0kC9'&@_/VngLt< rSO2yOIq'#N<x-şxDExLnn9b?㼹qǾ_F~ݣLS9!כ5-{ֳ8ZM?C|7v^§=Ύa<&J\|i\_~'q=)>;Ozk/Ys6'?g 3珡s9ҹ t?. M~9~9 氛Ls s3zO8?<#>ߜ{N=+{}q]7wqCy9λC3=ɜ<]'MsFK1w0s~{D\Q=~$sa<{t}7~F׹joG<_p'D]Uy+c"3K8Ν-\os 0}=A~0s\J9׆͹71}}mϜ8;Ϲ=Ü+>1$yΩ+;I)&.75G~3\ =< z ;yz?}03s?we4Qg517L9gɧ'/HF'{ }ox[Wѱ~݊[cp'on_cݽx?> wjֱ^蚸:y%=yucaۿM?|PnZw}3Ǔ6aΡss3a9!9?ͭgGy>:}5=w i}zqO9'49e>y^~w!߬Ξn^_?>,YgO | ejc~<l,6:΂6{9Y~ֽ9?o3?&<>iG?c~<߼;i^NG7yg5&R~!ki/p'.}gзw_p*'41&V/| 7κ֥gXs௝إˎeヾ_I}L?+A>p[kПwaG*pxŵln_TV@wkd&&?ف'CsPO84>`v[ymko66ORM O>5 4O O5v{ҡ&<$zŕmDCB_d҄b_'Ov-M-8---yԲ?oY[[0[e lݗxW}4-|5:nd|u>V}@[\6=C{:/;gxה^pۿR?}Cto>1uߚ±l`W^\߸8g,:qeRx1Q~14ƍ\۔V*b*icG'E1?~jL=[#Z}+HQiOuBQ租F-t8Gg7M3͕gH+څߙJ?")uHkfIƗ&^o<.tzWg۱KڒBev]{ڇ]Q~Lp3Y?+Bc8sY'#~q9} _TZڏ]3?;4R%;=؍w47Ӳhү_O){Tܣtrqq 醁t%r o"=I9@@"G?EWIL~8}|zgv88c)N:W~*;Mv՟]~w~'w>=뙸:W.^?ibZGD|C+a5=MCM[_y%Lb8e6_zYNxT#mm㾼Խ1p ;vuG>H%f\#^ u/x_tJSgck.Mz63kKbc-AR- o5 &hRUCƽ7 tYR/.b'=[lT_/~#ߐv{WWM\AΪ ^Ϫ*.V¯~Y՜k꧅ۢ:Y6>=߳0n[/ƗA8͍e]^CGz_'RcwVc__s]{)͹.>^v u~2}s]yNkįE7}B$r&TmPOUܪx9U~U~O5v&5W&omATVZ;L;|#UB~GqoZc7XsTvK}'w|jgub~ov(Q`ohWj׬ZZxCߟ~ 緹;&&|/rF[|=y5[y}@~~GK柝ot~96ק?7s˛MFM͕oJ׷wfSruz9O5/mZpQrx/kw^G)PhY뎸 K@W|Qr/]gT [_'+7+[[Buܚ+. ϫ[uOxՕCɋq-PG9|*`Bt/qIO&&޳KģI;'|M'3TCq+k8$pc8V$3ɷ}|&iW70p\{w/kWծ}KUa~L;_N UЃW B? ;lW:ø \/k{ڐ?ORvQpO|pnAa%|6gJCK5 tޗ?B}sY2P92:WVc,?W8ŵDh2HݛLQzY7|/ ihlJ;bSqS|>A~+Kl9L?šIIJCUcSU鄟t2&?=gu聳XȟYkHV;;՝zgo>x^ ?yɽF;E~Ux U xO$k"<ר 'ǯszu0> \>&GIF<cg8ϝ*jG/^X We&|?.qǖ~}_hί.H?6p\wΥn-n,9^2_xvnK8[CB\Xō;Cۘ}.V}:KE\sƿ-Tawqc {@w*>J ;==GFCQKVo#ڇi@gzBoLgj$_L?1{JS)|֔eijNoUEK ߋɖg׳|K o}g'{C2m}ZSO/n`z2l{28l@C?3̾2ۑzy~v(SSo\] xcW;\X>·qgqrq6rv8.;F{rxǹu:{+Wk~pn}/1En/_mۅ?NwPWʉhΣx9"|A{:_tvvW@oMNWoAt(/g/ujrq{s9|O#ȗ 'w3{IΟ5_T?v0Y?E;~a^Y:#:zٹ+X+Ɏk.N~¯_.1L_'z|XUs}@w9vGسu{M|?Ayq~ϼzϐz3nR]]],'Qo;}J rԽ}ݳs;ڍqsm[ԮSZڡ!_O<{v |A{~~2wzz>\x-=ףwvN~w(uNėB;_8C.E?80.G;{oef=|fg=9m䧷~Qԏнq^ _~n|I ~n\~ <>hhPЙ!~$C~/BR8TC{ Y6OnϐxBC<M,a>89=w>{9xֿ"Ku}Ӹ.y]짡 w :;].S{8s=zz6sFu7n(?`/2>m$>/:3{IC߆ا^C;_?Gֻɸ;z߽˽ywڛ~G9˽y\B}۽::Glw0~ί#Me|,uߥ/y3yv:\uoyGw0?~Uwu]|?ۗGΟCr}_Dk5#][^8H]z/]X]K? >ރ]z 7N8EqxڷG\okVzs>KZvӑ]1*N>Vxu? ]syڸ_v7_oO)W(4{|#h r/׹}Gt19{ߡg6ķMO}D;+? #LSJ/)oߺS'>c4s\z73u+׽)@ev?r=}Az=,{t~~h|dNvvGfU 3州9O nooKwNz@W1ekA ]ċ :7/e>pX+2|Ӗ1_j|b_Tȫ8F蟤zfq糭M){l2E/w8cǛ |o'>SdpI:_O#IYBgIBꅛx+y~xH2o[Gx@72څ{ӻu3Uxq`:o]gzbQ7Nxg.9x-ag gy_x)ؕf ~Y-x/qjG*ގo۽^!֡?Vڇ[~_`QD۽g]iڱ~:|˸con]` ts_޳8m){t;dƥk;e#Cq"ሷO޼sϑ^>1֗_1.}wM<~#} Si|~'wqMs䷯MExwZGkʿ6@.kXUn-CI_gOQ?=\JOR7َϾϧ?cxϘ-N8*Hu'aKep23*vY>ge P{,05ƕe2: Zv'~j]:tN'WN}LAO΋~֣JB+ZOOluW}GOQ<,tzmtec^H/J̤yREgS H,]*>f&u+g~Zp%[bn}yD3" <6#īKL^w#_qժ#aۿiok_BېkqS/-}o6ݫ)iNU(hWjih>C">J?9jni9a dot;v4 7됣{SwWGk')Qܣ4~A6ƩOc=t [f"u/e'_u\<^fhjB곎&+ 2;AJqC3޾<j~sECgJR |z\i\" {go,/ѯ镬ws 3\+?3CAփ<~%=-7-r{8eve"+;)+)*orozK{O {~JG ϥҷ}-C߇-+-yJ잿lP7.l)'-_ gB$q{f]V1K%uT N>ȿaMiu|AJK9/KJ *~c]c+օ}UVhrr%y"'Nإ% |LOW'+O2[C?C?١?Uqדv3w<#n$s<%pZ-+:_>U#|5WX++ۇlp6xd'$aϘOi9nU S99𭲏q>KPOe#)s[POٹ|yͿ.uЯAsa #ف ~''f <X<׿GWx ;1aGOzʞ_̄; 3 )3Lz&fyog&gnų?{vpgs p%/P; zag>vg}*ǿyWv#3nN 1 . :g,aƍRv 3]M7M蛾Do[}v9s0}K3s~룟; _;}{ƾφ|YOS<^3@L376Lqfo4r2o~K.;f303ȸccw{'JN.dM_wR7swzL~9?^y'of:c%rc?0_?O7]48H.Mnϰn8 O< ~4NnڟPL7t = w^cˠ?B}NBz9bapuO&4Lc7Пs݋O[<\xz8?~|?@ُr7?0n犋t.=9y:A>΅7h"Ovg\%Ӭ-NuO>M~6Lcc@4w7B{O{)a{L 3)Ck>}hk~Pn<O΁-dоvϛ<}p^CY_o^}x>:wv{ޗ~l|c>>uJfu~i~8ߵagѿR0?_|p˹ܼ0v_z/_gϟ)MV_bAN_7X>^e=ko-C;'d18a ~}<8< !;AkΧzq4oKp~ipAu8i~+ϼ9Z8'{pGK4.pdK?JQeKV_p9̮s)^p;Yo.ge~e2x(\J!{jeWpU˖O?PJK~[i|LP~g> wZ~9PNVVI++8򇯼S/KH /z筴?R~E?Ɵ鵾| _yrX"'Dr=i>|gYqƱ_3.__uY:Q~K~v'u}\8!Kιžл3U_UW/c daϯ_ɒ{uȟ̰~O.\>tr%}"I'+Ӓpycϯ:'ïxSTퟫ>UUrQV\ d.yQ/ֿ;}IN3γ+\d6K^ V_?U*4UyW9j55euGD'=ޚ}bc!}3pQ?調ޏp#Za\s75aA?\}Rߍ䇟[{WvבKtZ{95}ޠn/?;O͞=:ᰵ/k9Nk;{"-R8\vbp.{ztot/gC L/޳I٭/~fli.%}ߓ]kS:=_6SjK]ܫL7١d\b_<3v蕳G͏,~sIs' w|:ׄv+wйK;wvx[{]Ma\;z'uv|\Lxw:;9v.\\p?t@w # ;=C__?~a}oAߣo{.;h"gew CW|OB}]x?]L]89ݕߊÝ__o|^P?ĩb:e~bfs0bw.>Q_|ǥs2_uVUy۸:]|No.9?|1m}XW;K;ϒgiwΝ+oo:տ{/~vr߱ʉ26#;&N6;vo _(9N6f7nB?^R|\m|0׸}?'_8c| Es ccv6.z_f18c۽#>Θsc{;c<~V/Áqvgo9οu|tpQ^F\ao7u=zQhoQ#x>o(?F%,oP0|a#zGodSֹ0|տ|Y WcA8xza{HjgAPLC_l^c&gF񋾪s%>|^^z:/G aOuK//oޘQ P p0;hh)SD7 0o?rK{ w={6GWCwb|Hݏ gx)b˴^?oƱroǁC ~"߰ؽo)}nf;=uFC])=pzIȿh73b>6yqM3E7ufb8^8EN㸱SS'_SO=h84L"U}V 5К5wEvQn~]\=æL{+oNM&;N«h-|w[ bۙvb?"{xu0N鏋|瘟ZGSZcPZ_5#򯨺*RI*=eh$;~7ɚ/%Vna/|z(Wo[QU{ W7T缏Ob׸<p_ Rwc@<ȁ?G4u T޹n~BN1,~lwA)~wȧ6Ot%PKG3ky$mi@_ aL`_Tr䳨?ޅq~)?1}E:}%~sCs8!)ޭq-3kyU|f/[C62b́C{PO! 8 0 f_U̓8>FyIMt!*g5x??E_9*2[]~ <.9בD_1.biovP8yq|0v Ju~QTE~\Y78g,+GnWqO^U | IT_,1=oŷ93%֑doMĿ?7TnB_E?c}* Xoq}ǂ "Wٕ*(.D~#>sF/v hGY;=,n}I߲T+v{q*D(я"RxSEΟHǧ+~MI 8ǐL{-;䠊~F*kRC;E=ƽꞱJb=5rZu]_><UN_ f8LMcDxjmmN&n[HchW\"_`j ^8*E=XLߢXOLgC`S<]]ͺ\ثXReGQeOU865SSQډ*y1^0ߞrh[wgZ'}0p*/ɯ!STg"N zxdɹReVӎV~&ìߔh+r&U!CVVfx1]:'{.ogocRa;37D,ϲ 'ht}} %P%~==++MS98ٚĀ}ΞHrH'>N:罈U)Ezb}lE{p+֧H=Z">B?kpy_*QO.h>2{8N1_~O=Ngi,>H\bgx|9 }Gzp "o V/2Ȃ/Y(/HKU8s\WWsҐ|N_(}boONE=_QN<~qKv'q\xn>FAgNb}8b=;/?;2\ \nFטFx:bs, Ǧ OlXv][Xnjp0pdKWV ~HK#y"W<+/RR|JE=y+ڏ秴@>~ڷ?+ڍb{e~3"#S_/Z^^>{8_7EUͧy;#ަ/_e!X\Qc7,pAoa]wt/b=c=v"L|o(ڍUgwz1{,+fq<q#r>5S~f#Bܿ,I{ųH_۟^;\~W:d[x;C{8WMI[}(]|;ԗ#rF:w9i,ǎ:/;gJXoԯ(o'qT7~} SG3>~9)o7cWt|9u<{^88x )򩏟s^H^<]aG^y %u￞_+ƽrLOgQ߾z~K/ަHVһU;稿ӯk*I̞D H3򿭽X^ז QM\ښ^Lϳidm1t~h)cGLC']L_١d[Tk3zz('~TxWǩ4Mg¯.No]==H:<:ګۃYc"٩Dw~q4+SiWLcO3;HOLc}{; J_X0Wzq:}8=}S ׯ(wQ=?/pES֭Q=>|s;{uz\#ӭZR8 ?7bz'8Tǫog݃UoR.>nL)|=4>il7=sJ={7>4~^sU;#v񜓓6ykZGTOyT'hެ( 81Anjpj[GNDO,ޢh78EX?+RpJ}S+_e]ϿxL'NCџ81__5UԇO5rS<#5pyq=eQ'-H%b*Oq.]7e4~9'nRio:q[W'޸땊R]?vTϝ$%z~-o؏9G^~qjy>"}B~ oAT"9U1n?ux1RyGŨ)l۸c#zSi\/j>V@LJqES|Ss~+)Qk['3C>5UYsRWToR3*"_=&'=R=DW+ڹ3>?he?}@۟U5N6ϑNN;W-S)G笱ϫ«*98.5Hg!kpznhؿX'܇}̧S;W|󚸣5PcyzZɼ.C^0_.{ƺ~@x  ~=nasO(϶!Fc>^}]l wqJ |msn4lV:r+ۋx9E9 Ҡ/n\,x7Ct?<+yh?xMׁ?͗2[ ['o'C+:[p.[ ہ66q[a>  ?%tMOksy>"vs,uC'u~$)V󻡾Wϗƃ}\󷡾:{BK'>;eްK*.Fףq '7QnAW'KwHoX"f|v5[4.v1mmmƻxCRhog?SW#=/?{t!M8s;#;75)򹹳~:_;{‚~_`}{/諟E\.]U'm|[H:eoee%?T;E/Q)>G!g5Oe Ь475+K 4c;]v@-q ;|YMo||/ܝ2#n){Qٿr P w}]u& {"?(rr3B&|| oT=}LǧX/^k-kN?(>yNvy W~ uq+X/|Ǧ+|כ||B޾6}t"nkLE 트p/{Lcu,{Fʗ}E{wCR(@__!W\="_Sؘ^Q`>"q񮊻S󩴰OyQ^Sܲ Q<>xrTGOwUU8V9e^ =OU|W%V_V5Ѯ.Aqqa|9v%_,l*Õ0>q8Xf'=M GuS;U?>o9:lM&nS"^Nr|I?틞ɿuI= ?s_1Npƪ|I">LA@rr凟AE!_EJ3|Zb ǻq/)_jWق7ւ_نcCAZ8_ݪuo}sY<=3C3o[k9i[j}۹pm_-q_Zgjwsoަjkck['grz-ҺVr>׫ϋ1"k_ؼ)i6[p:Ovy^u+նkw>mmjd\[y~gˈ^§o!i|WK]m6SK|ޔK }>8״ zbՂv_q[p ܓG|oǽ\ :c|-D-qx?ٍlʶ٭ၥylzU :RS't _A 8/OwUtЏt@_? ͞5[k4?P_ 8]ICϢ|xӵB}~JwWnu!w~N㟺O_ 㟾_(@w&Ulo+gy )?6Ku~:W?Cf\.2nQ!_lx 3qyB{ٲllP_V PR/0|8)K8!Û ]f3ُBoxU\Nl_s*zu3~wY?Ȭ';=٠v?gd+j[KNJ-oW=[#XUSf|֍&E{W)1_*+E1{s>;?﬇>HٽW"s_'7>$]|l g eծE)N//eg˞6x5?L{1{Uq T\xӰepG#?;{?=I>cdܝ:;ag~w/=mz.~v_Y7gOo?:{|ϧInu3#ggt>_>t6 |'tΎ,Wwv C霍au^?Ok#eoǪmtM9q,:{zz@znq:ON~)|I^xrEʧzrĝ+8 ~u=>˶q^kq Nn6?ֱt-㿬|GӯR.7~ w}yG9x]\ 3u/~~\{#VkIG$]E={OAzÞ៦w#+[Agk/puoZo߹^{q}mU/OGwyAԙ-9'ؿwv1o~ܼnOw|Ǽm{?6wΑN |nWyOy|CWА\Lauh'_6% ͷ t嫇z/@흏Y 򟯋WBEճy'翞א)n¯6튯9Ÿ7]8#s~Gou矡\ zӎ{\܅D:׵ºu t ttcEz_wܵ>v!ήK@Oo򍩟J>vo^S\r܅҅}G}?A$Gtt Δ\xtS?w tȷz =])^v{G0N]zw\=@Ƿyu!b5_=L;u3/Aqy|_]z_Zw q:I?I W|.+]CK׃ E{"MnP<7011.߃Ƴ*{\<}W.|NOa&߀T|~y0Qqb9:&7gi}E9hatWOX_C}]qq1|_DA=߰NڻM w휽DoD|M֯ӴW"ˠ>5o]_>}<ڙ|'OtCy2zG u[/};~b ÿ7}п>*;}nW#*ߨdK3Y>>>{esngy.37?z\>_6,;A[zފ>% G=g8ѹ ִ1QWO/(( """( JS: ͂ HKҷf7e $! I()("X0Q@aATQPD~z._pd9s9sfG{UB;a/?܉tkc`_p߉~x>)_35gkG~TR/ ?p^;Iڱӏlxo8~q4)A7A~|>r3V?Lbw NL:+AW}6$"?2ny0o<ԇ ڑ=Cf^T4љFe798WL3gbE܃/EYgwYďl3=h,9+Lee#kڗ}@V/+Fe] __1{΁"R읲W*')k6P.?;|e9d>A򔃾?/0|<|&W}9sIw3NЋyfc?Z398lQSΜꇜf3_s߉;e{+ugnڛK|܃G.l؎"/~J)Bߍ:Q^_xB݅ػO"V US.WrRtǢF򋆫!=LjRi=C?EI_PhEĞh(|R vE|P6`سQ R9e+l) >Iǂ ~>mÒD E!natcGWtR;t#X DOa軗oԮB%)xKK ; c<pڏ_Gh;-x#R~ t 6b,q^6R!xhQ! KZ8 ׷sg!S7#& {*Įp ߱-yT~t; ` j.xa$@:<}Wq+yd)xoi7 6_iE՘SN%qcCq|q|C N)9ROunj~4_tmrbM4_lBi*n7}J۵ =Цoӏۋ?ŝ$O+ 3H+^yxf<'wQ{oS<嶺Ž%'ţ+TErStŔj)Cq=Kjx'mѸ*.]Y^U}%?K%{4]%eoI֛U!SL)JWtttA})qJ:ZH[:Kď x,coP9ŧK'ʏsg(##ҼW^~-OV^&:ʫ)7ELzpKתmS^g?i]h~(G[,^<h~vn{~UQn䵪r|Z'ʞ錯w k\VaOW?Wx8ǏS%qF*U> z+]{ʻW Oɏ hw+*O?j#y}G^UI?KQ yn*U"z]w1W񷦏Q3X#5} ԌXNͲQSzjjjKcәFzmEc5M#]hl`Y` L 6~_e~ܟYsKc;׈q60(/ёzm#ok?&/C@ɳwd7Dtr$*ڵgo#ygEͫyĿ?k; IQIןZ'j_YjgW¯2B|?~}%m]Fj%75ŷ0gM䵆w/5)Ϛl55)-HW/P30A,ѺS |BiJ= m5_XN=?՜VjߏZGkW33wgc!u=:z LҼ ľ00zT5yK^k =8ˎ.K=5k}/ W{}4?vCNC~/pk;bSs%>$:3О}k6͇` c,8E>Ÿ 7TCͧ«9qRTs@SY㳦P\9Ɓr핌uvL<j԰ܮ}O Wow@5>4j5j|\QZ_{rT{F jkw7k_S;jվ٨SIށ}\%úZ?vt;j{IKU&֐^㲶5o-_~l4iݭ%>Ε|Ԏ<ӸQMמu7jQU^}+:xG_wT;nݺ%c,x zj|P;Lx󤼟ݪyvWmw~?]L??t-V-$1>ּЋ̣!P8b@y==O9V˼<{S?֥0֝sk>%'r܌y[{^|1Y_~8PA oyuWDWmEK5f%0)_D]3^7[N 񵎸uuߺG73wJj㒯/TnK)'4 ji=WZ]GQcȭqT1ui_վ']kgmC#^S-98]]A=KQ]?\A'A98 ,R^¿q"tzGi^ݣϙ+0?ӿ3'ƈZn7܃jBqy|~,F^.F.z*MG5?]D$s?vܮvpOi)O)O18xܓ$-$죒ߓƉHIJz3qd&>KIoI'M~5tK }~@<_xw;/qKޤivMI,yyg9 J/kJHNiG#:RM!eFwUg zH %7Br^ǽ\՗q}k}n|UZsT}?PGG)?@ؗ']+>)v qcҚbwy'0 ;l'n/ZG=~P;~w7wOwػû "yo13?>v魱_O/o{o;_=[ԟ~G{!N QoU??w @pi J;ޅi6gڕVyǐroor{c_~48m%0Ӓ}oK2|v/_ޣ|?9/La՗vzyyf\M;9:oIy^ߴk&;s?v~௃5Y_[R:~'c|r\|ނ'@7󮣻7IHHFo"}ڑ>Nޝ*?} z=-c~5͎:5p3q,dwa‡l_3W{ rz}k⣦YocL-c/O*R"sDo(0f} ~ ;j5 _4t)BݷCڟ|rW%}\uXhtiOρ7niM=3v 3Oҷ >~C?gE /Q-LR}I ՛ʼPʻ+!|K]ʾ@nW2'?0JeB\ 1;ywZE(t\R½j*~S/_(7aj_SJ??軤 {~ow):-LDS" Ǎ?gJN'\EsW7>QtcLt$;[{>/=/TysS[M8/2%/0yIy|>MfT9ɼK~NEg2~4%:tRy)wH>S뻔8"9/'8/N*%c2$?&;oJR*ÿY~NGg$qOzxA!i!|G^M 2w^eO@g"_=Tl Ax׫߽o]qѕxZraqp y?(׃w;.ƏWc)K</UI#o]yhI9JhR_qє;Ҥvൃ}iRo{~S@MtxOПGx.>^8^{<"7>IcnK|'䁸^--｠z#q<]ȏ6~`陁iv^uL>u\ݕ:<<&βx ֑'#/ܵ[9W{O/l=voyc'~Aqt,Q0f.<.QɕmmkqjNjnPmko la3V]Rj'^Fَ?gzc~ݎh⃍62S} ٘|95NBoʷOVw2cFkQ,6ORI-o%D\Wr~75wGO\xOPYFf%N~Ÿ֊3c\c%y5g/ ?ѶJuԨϫU~3FAq mO ?߆_pHyWo}/N:yˎJަBFc}mїv?yra'΢yA`;~v?wrSOyY3~ǏMo|!ywwڣ~szǻn4ֵp {_뜃xtfpgÁ8 )CtT?8o7c/}u!:a^,γM1=Ɓ>~+_;O'.7xdtÉ8sc7ʼn$#c6^ˁ?rG-۠1B#@׵~P%W;z |(WG'`>8| {[,Wo #=D _ǹZo.M:y#|<9 O;N%K컟ArOyq@>#'@g@S:#~8'u |z\qT+_pԵUk`sO9xqCsU_>'9u9sE"zjHDDQ(/)KĿD>%FȻDω9oM\%;qړy [zΕ]#O?ѷ?urG+s?.W7n=nƹȹ?~1 %o%Rơ8ΑqJsUDcWE#^'Kϐ^uG&{{;p߿8oJ;B vG޽ yPI,bn68+CC2Q"xJwz,Sb4g=18&?ЛstT==owϞgVA y{W/y˽=8=8iԷr+e%ލG9r oG{gmFCo!zWnܯy4S?)q诉I ѳWpϞ}bAkg/s`GṚt噡w-`xзx2Y{x_>9?? q%^^ŽkWo_@^qi;g3#IOܻk3ؗ2o&qOQIrO྇}ndYIş$gG%Hܯ$J"Lrsї|3_p:⻣7>$SHQIہ+$%ftqLFv%N19_=L&8NyЏ0ϧ#gS})_")SsD)3ُ&/M}-~y>[59 Ln-J=E.B{z9W>^G5C<ۤ|Gy\ĸ!=~qг:`g2 ibK\EjecF*ϼ1\#H~By2GwѻCqxކ7r8yBߑ>nAn'ߙ%4oM_x|ss^|ߕ k҉_]Nq3sԞ 2H2>R]3K5d]DO&v&LgR98|Afeo-sįa&2>~\K&?3\D9/Pq3[S {(_2|Aϕ̫3k&q:2o0tT3kfZ>.f>O{?3S:u< #-#IDڈάEsSYU_vYQjoC-9Z,eEYρ|fD_V&S{=M(ש/}ڑ=Dxٽml~]_R5Nd;3x _E?gq$nbf2[:L? ߝVg-av'sfV_5>:7ܲl/e 独UN6+f^(y\d]ٕ_U*'g(>vQ99&H6z+߲?9$9W9-) *Ga.gP!^'9/1uRkU˒l]مA|<䌤3xI䷀_r͞N>{]Ž_zv.^L&lY:r^8WQ2y9}G&'2y}kf4؊9qA Cd4g0#6GvgdRO*#;> ?ψO|4 +..e}xz|Лdc}Ռ݁$cx敱'o3oC@73I /g5cטG7ٗ~j477Wge>qx)$=a}~u͋ه}rˠ]+/B=8gR2 ho$La~8nsU$߼|هo>z ${dW\ޛ Go}?(= *=@O4JPo vU)GHL4%O|J>8KљJzw $Y.wт˒Ϥ}7^bDZ/̻:ɒЏ%A bN*T|$ԩ3N,%WN259J${ԇ;k|HW6ķDn=SOB7iS*k%!}^ )UO C7EBIzypц{ܻʳ{ܫ|ݡroz2ۼzy=샼 y?%=S1tνh잰ww99L?yOxz?^.ǹNՓKܻ˻_>)Iynn`?p]pN܀yV?l}>;?oO|Ԟ'}qxG{s·YGJ~.A/ 9sY*g'%g/u{ЁYb'1fo.Yrki;7H'fK'oڑ=M'6՟w)qu8͒o9ܛ\ѹ%\.ιĩA|돜?rϞ߆G%.20^z3гN/ڛ?q w w1Mg3Cî o~~léS6C'1W8ơ/ wy蕈4H~{FrE>̟s[Ar_`oƸF:Bz='d}y$'_1p;x2 >S$#]9's^`g{z΅p+|.qw_^ߴP.{K=/HkYn"A'> {w~#ijL>WRPß8_篡}؋?{[yyw__oR׊'y778)+N 87!7vn٧8y7wrl{:nI|8'qCsE[5I[ye>YKH;h\XQTF3TMf<&w++:oWqkş&b{~rտBx)?*CF2f?Jc~oXףMۘ=}qCO3{{$Gc9MY*:e.Ҍ-׊ bkU}gy_r"<*ˀ rcrh\_2ϳ]rmSm2Я4ٰ26o0k^za'6ا^l/:~1^ 7g=Koc?>Ɗ({8C >O>p?ne_me]$]BU+ϋ/֭+KOð>ޓ;@ +'ƺg@dݘ}7ӮC}Yym-P;O{+ɼ]Z0~LW && fwd]>.+}cE?#g\o}GYPxQohgD&(G -ןRzu7}=ՉƿG-~b=>%;qz;ucZ}JEb/++)m̋[8'{}HܘjG5ijXUU^1^/GkyOշwy~_LWޏ_ø;Goa3^2~YB>>o"X"rH]ppqg?}DUתSm":"/[_u]s]3ZX}L$È*/81 V^} g{0ϰIi7?wM OR?5pދEpO~^9'u' aw]a  ]55cV3NWe.TZOrz?/񿸪XDV_o _yWVm>5Mus?"W~*e ~YWq2V.cV}/0V_~vJ+i*޿&njn 0tƟjc9/zUgU~_þ< ;09aov?y]~CO+r"|/$W2sW|Xrd>Z8}^xhw$}E8D[8~:9E4a>EQy]$k9F}N=ZMLq*JàW?W%iE\xU~U,>rTx89߆od.*[" EG&bA]Q.AL_HH瑉1)P$굼sZNOza׭{J|[zރg~_g9 վ(D:E]QQJޢwEU{Np##DP{{V[^r=׳@7.$j7z_|w4֋G=?NclKŮQcq<7Txq#ߌ382~7هo'lA&MQjɴYЛFzi bfޥ?ل#r5cwc S?Y8[8О>ތ)"~gmF^/;i|izY%`ib^Get&%Ewyg%XXo#*82wЗA/zA~؏$0&p19 ބTNЏ r>.}x2dž*?vq+?RDwmS8'zTk/Fɽ]<wOYOe!q>===Lq/00oy8ɸO<К}x}C빇{$~bz8ΓqSq){xV& &G{$Lu=6Suh(&f5o3:K{_36Onjafی?_*g>zcvS>ưQ3l̼4P{Lo6sbžT~0e1.'''qn69` ~eg"n(_Iaڝ@ׄK'Ԁw+b;Tṅ 9?>Ĺ44O&ƝUs3!$_&L͜KL3}C?_01_~7w{Σf! 36?=6Gr /_Srm~jKm),%5Z*ߊG+)Z+?_/1~qvkae4n^-!q=x?y}YkL>wqz<=3} Yz'I`9?A'~VsF3Ig}oOA<]Y(@olA=A@c'm5Bd=^яYrOgϕA:߱GBN/ފ['_:KBy/pn1#OS0_i^Q1;dۆ  g)ty'a0ln<i9O;<@w3/CFwoqhζR|P9ᾓ8x;cd6# ֳֿC)~;ioh{%+뉕w3SP#8[dgԊn14< ?&NJn;"Jyz/e1nBNz0>-=s8R(VLizpc}MDle}3gVVYW2$ОиMDCq)ҞqMۭ ޚW}pj !+,7 qB=fbg9vD۵zeE9<)YS]L?$!J&&ޓKke繁{;3"3FfmGPfw/ ~vh~0 _ʾ8H#VLZ?g#fŮ3}hЃq?G+q kb>>}qwIyh|'>g`_nÏyvY9W^OS?ٿ}*׎ݹ=wv9_:fpA':>'?CR9S.N:G5aH B;ۊ^'2gCžlj> "xNĞy *}wſ.kpt-T9po.*WU~'w!)Z7~ؕG=ng;G7}Z&}{=GK;rvͺ讕7KhRuqnsroЉ?Viyⳓy։e.;WS.gxW|O757 .ٹc&n7?wq:N3߱+psqoG'uߠ]د7}%&G:)<\̫.ɕL2d Ep]f'orFz |2wTB\]!.}1.^ /~Tݼ/p]/.Spqo:D9gBȿ3nU~,tbb? Ԝ!{#~[r`p~G@p,c}`?h=B_|RCj\; ;vv;lg`=7vvQ?;vh۱ӱchoSOyoks~7mcn=a? ;)G7v"vo/3 ~qw>$wr]?J3⌺x"]]) 984.ջraO:g#//G򂝞uƾvC_`0);лs3稗{z'@N/&֬u܁?xq9Cqh58೾8{ylNEȎxF)@ӭ9~d?}p^|C Cz0I\98=VxY/~~xVYc:3vBVY~a:?C<_1_a`x%NI u!~F*c_HoJ=Y7wbo:ls ?l{ l輅q_mtN쵍9ƺ r_eyres&ŪLB3BX3qͼc0_M/+/I  7/=t>^W-Ѳz XkmAlP/o78z`튜g| -K:|E`kZS[#af}wf+xg"/앸Kg)~5CW'c4 [u.w;ćO(hs]>}hpvQcT:7פI+i&m[^U%-*Ko^jI$&ӵnbfϜ¿ƍ})' ?~BO6g١L619S4egV/_/Z\vx;Йc8>aҟ-, ~`="xY|'/xR?y^&xj;Sw b?rg4#Z// >P&?&忟/¯P 7|%C OaM)# ?c*>JuPmK𗋄O)JͿ\'g*ÂO0Q? 'k*CzD] c/tu-|/"+6oU#MkiK%MݫoTق[L~o}֟ )6w Q=$]{ ƃ¿iۯܡ{q;ݨέw)օrT+g ~I 4ߑ^cG_(K<#w(P7&!|¿E{Z#<*# l[!xt1?*| O8))Ÿt'<)Ki<#tY7 g/6ʟBǞW mL_SE_0EOO;?{Bs _jS{ ^ _WT_G/ X$8#kvU.‹S&8._p}2o lJV!ʷl?"aAw=]'<*姴%%`yOW*=Up9l~D i8\V~g7 /6+4Vo~_ek_U[: nnK.v+wZ WW 1>*/u%1M;+_-Ӱ˯I_*υS{V޾F)7*~o!˕sk-^ ~J@G ??:Ro,c Ϭ?'??^Wu@_ [&'_៺^^T5|B髄z3C/?;YgUo|~ϟ)ʿ ECݥ{ ^?Q¿|/Ә_F WlQZ#~K״|M@>)W+?[ n Eo'oIm3oo !뭂~^=ne/~VY^{,~~ߕ/g<%n{ ?ȣ!v|5 ;?v<#ŖV/=]sG+e=CTk ޓ/'T&/QoVI)w=#p?'Uox^m-GÕ?ZcXsTzϤ'b/N RzןJO\RzS1] =qAO Yz3ן>%7?*!=q/HO\࿲7JO\WHOl*=q꾂KvZIll[ ^z`}7HlDp-o7x /a;J$oH|.HVIMz`}= ;$n}~?郃< >8xAH"}pp菂K|>88-x=GJe郃{ ]/x J/ +OYN~88iSZ"pa釃SNG#O~88]ʟ%}pp9/x I|\z 8LgH\$=ppn˂H\RK..x\˥8j[H\#=p0"UiHk  8J`q=ǽ'8^`}7ly^UߠUߠ!o`G3NN{ z z &g N-8E`AAK̐7!o0C1s H̕7Z7H(o@`uv$oX` Y`r[& rFVۤ n7X$ H+N; UK,op]w곂_7=>.ߐ77 ]?$w)o~J?Gp'6H?< XK?ͅG }W ~~¿Q7/^~T }G_w$ݝ'4 #a!#TTF/{?T$ C?}/i)topQ?Y?ݧ4ݫ4)_iNzWt`=LN{?F2 coTc nᏻAx4) iPt0ZOj&I v?T]Vg y&_6=经x䐜O*8МbHtphN-YrH"DXsXri΢YC 7=]]]>߶S#wނw.w߄AF<Ż)xz!YqxBQEj (z#5~4Mxx([sz%5#~,!~|LJ_OOH&飔,;t&'_4{[)R?KyzJ{o)xz.Cߥ|+ہ{ꂟFmOSCb* bkϠ/S}f*~& I~P,>~=~2|0 _S!KY7M͙Cҿygós~3|95Gz:0.~b;>OELG穯itG#_Q}*~)z_'.GGo/T˞cUL<>~P-H~>v> zC"P_IV-!U~ug|U/<~Qś?ïi__K֞ƯTfCY_B|>~CC|"J'Su+U;Ij76_op*9Lnm-msmTyj Ns ;))S OUwE՞﹎OO/U{7Uџp| AzUu0~UegгC6>Ue6gê#ccxdNUW?No~EWpIz]u~We&?;]?=z- :CrύlϣVyKylYbun1.[/ğzdu"}x9^!_U^L2雕>ϧwVQ/7__Z^Z]B? j q_M_3_s_K_V7Սm_6 [?os՝Ow8>s[w6z?7W.u??^Dc/ѷ''qOp~iKSzx̟gY_I|T|1^E_j[/ۏ^|<=z>_I^m'K| | 7}_A*_¿O7Eob.@ Wz>@';[evF oktd? 5dG :k' ȯFFx : o@suHȯooA7d }gϛSxYu|3v |ydd;ijɞAZnƷd k:o7-ƷoAZ[{6Jrř9bqfv8 bq ׎]D^}y a!ޒX^[x+Z[dB:Nwdo!;~w>id⻰:x[vb{ߕ}o7ofnC{W= Ln2\aޞIu@z|/ԗ\8C|ޫ}؁HAo /wm/\3?{ߟ݈ `?"?<~~l<`v%2~r);ڜYaMæٟPd'~8{q|xwK:xWv*9ޕd"F?j;~Kh-1YdL)ލ]%ط??~Z"~^djx/2~;xIcd ~2;+ 2!  ??%ɎF<ӈW(ދ]'& v82-yn] Q 9NGf b#. ƇlCH0<?]q"Jy}dM|8 _g#_^!~'KddQ{"vB8y6`|OId |$;"<_žH减:_!G/IV=ŭf$WWo7.g$kzְgqlqp p7IG_;'I $-gAIR.~{(.J6"?9>9loe7%㷱_=6~;~G:~'*IOa_%))dr+]{_ɞMOqido{ו}qە}E$>`%{{^9x }dDCWsHav]}>J|&w%H;a%GGɱYNX?ν.L؇Iq vbr''OqW,<$4;29==C% Tbg&sٛI $o(y'K^ ,wrv{49;,g<<41ŕ3/xnM2b&bvlwN|% {h|+wrŜ+E˕<|RDkM˵kO fC:[D~m!{iˮNc_'vﱳ/y}P*ɫ^\*27^[v,-;Bm'w)|r_:Bm7dg K5ꚃnZ\mv!Έ6Z3bKqܧq'zKyzu}|H|677]7TFuvus&u7]77]7oQ7?7aMM?Go}noɝ.ޔ]67e[ķb'[#5w[|u]'ur;JmoƞRE" oݽn7ߞݥnߞ [r-VN8+=܇2=ޚ}}ݱ ;q;E;ԝoÞS|aש'ߖ~m_wmcv>un?uw=ھ ޞG=؅=هꞇDc-ߋн؏jT;R{4N|mt|π[WZ~A!_bd92ҧױ 9wfooŭ  6(ʉtpuBv?=34kxyv ys߯ [?|ooWwX=;ݟTvn}͝=gwjndwen>;7|uuT׻ &J`Y=VT~yP_ɮ@fPortfolio/data/LPP2005.rda0000644000176200001440000006241614254636366014770 0ustar liggesusersly4l,1B"s!dH2H !s!D*)2%"R$p߷]~s}?YߙkˍÅprp\k;;]Bˣk'7"x IY ^gkizji qx5XG܁x,n#؎=bgwĺV7yxRJ$sɘ-y@|r૿3k1$q 6o7J9~'Y˜ZOb|ZG?ṘbrKv# @YEP-> ZU-\#slffּl)Жo݀;އoEuq=@ N7x(uKa1Ml`Ǚo{& >m_W~]sr\'ۇɣ3V˺G`v_:W r N~V_&kƎg73?ः-DzTR`gͳ@*j_g#הL uiR3˖oW @5="G@jynyo޲2vz\ݗ/"yaƦAus:_uߗWiW5o+Ȼ+%6I{2bu׸O^나/KwբUI~?4QwtZ8K*ڗOb Hǫ6JbY3ݿ1*` :6ZyvPٯl^0\9˭A[<) frgB?W|#f;u19|_"-LN;~uU`(.?juփdJY@؟~Tn.{Wiq-nCFH{9(TjPe+^mLs*lo&;w+)g[~GUilMvˮŸ< {P!7f^ j7id7H  IX.fGVKiIk/=b/426*@{|:Π :).Z) ID? y޾ze{!G ?=ǧ }~D?{ MPBW- hg+8n=pEڠDŽd#-ݾ|GL/:|,G/*}aRџǖTzϗA@YM4z}0] tb|dEf!@F*(׬K&e|֒Wqߣ#|~|('Z?E}y`h+O=.7jء@Ϭ]t[R䁝2L'N%S6ohV=8bI_ S-3K= 蟾m?-%EK9\~~}0kLtY'-Je.P[Z8bzRnj~-<ډyG-TfP-ƻ2w_5ug?{苦2le' %C@L]M6툓>?QG; qy`sխM̀[?(S׽>X⧻j>2}'u5: P֣4֓–!C CKo 4G )鑥}@ n8;W[SUi.>zF .>ԝ!ico60MU@yw;qTf74ѿI@/^s ֡&S@K<P-̷ن|l@b`ЫEnRl7;=wq3кDz\ڋ{xHw [=vgk6^tY {'qvymI3@p8Rs?Xc/L`b c#7"^yaCeP0,CP$(XӦKX#Ren9pvB`X|9~&2d60Bg_y ޔa5G2?0S>HFo|.:70s qri{;0.|ih)E!%-:F{=\0&i4j9%oSUOf`} LݠܜT&϶`*r 17S~5:m7B̈́ wsJMA,yXvl·"r}wzpZ*w^;0=9ffi7e?GK,3Vz2Ff~Ō}0 e[Ij1[zg70s ,u}q2sE<{Bc1YG6;H#0^6LiJ`|e KScc`'yTWhnO 10y>b2y+0w;`ܻ wfiۃQ;`ı y_;qcwu!0=?McZ5Y?%Γʼ%1ZXsVU=|U Xܣ*nCT?9 ,Wf:hqXi&VDE+5m`ҕ[* 'v+DjGUr$XAΜ{,KY:խ8sW`~ ^Ť_π@`Io֎ҁ1eriKDлR~&o&0_l Ƕ5kYȻa6,<YX xp9w |-4+|rG u#`E4. XӅ:Y}=`5k^=kX# .쥆iT8ɧ{hu6m"[2N5)?~Ń7=H?z} n;9Qy8O^H u~ܢVD Ohm\@ص69 y: L8mp~c!oukжk9@r2چhh``8.QnKo$3nru@Jo佊:S䒥7sۢxݦƨza\4 !Ϛ؞tRW M=gj wE?m/2qgފ$yʯo#>轋2 dKvΎ =-ϥYePw|H [m0Q;uFg /֊o2Ll* 7K7zc!xCחnwAu7 SJKNޓڎ+|0Y΄6S7dSУ#.3}Cjv!k> =%p7N`Οx?ԯ52xS{v N(F=m:ȈW=vL873wuZNu_{r09dպͧ1˕},[U֊{ [֕x0n74afrrYç}u ot>=Ṿo q/3=:JȌ],_}<وU@ƫx#Ͽ2S?Af3ދr\}Skn灧G\޹'bLW"m69BHc%π-@^Gok&+TQ[y߽ H9Njqzrl<{t wm\uU7\#s!"ڴίeUO<~frk Ps(vF|_Tz$Xl*2C\P^۔ 1v9m#PJ<9g63X%@iϻ5@>z_Ԣ䲸_?OJ>쑷J:=Pu%G|/_*L+%% %ڞ*I}}[3P DҭeѴx0_(:x{yLLOw9v/c0F }@L 6"׵Bww+ ƪ2w"|}5?I2{~S2tľW٥&p4#s詽tWֆ"o*lӭ*U0&M:WB?c4\Wdi~îʈ bfxx0UK{ IY-) xo!Zա ٯ_mB4q_d.╫E)|CAI{zN{yN+s*˰K+ձkiXOVaIl@Y*\}[/-JW!oњ$=gj ofxmUVqqW;k;?V̸}<d(az|ӦhͿ~›iq7~3j݈qm_DM33es"-a/J\q߯9~UyԷdsgO G[g22w᫃#aR"%}7!Wri?(r G N}gc \WzlwY@-{23]S:^ ?ri Պ ro纶vǖ. q!o⮿o\wE-9 ԯO8ü0mVgz-Aq 8 ߞkk'Qao0 u លW(ڼs,i JQ;wͿ D7 "ܮQxB˽2gROu4a֥xK5ϙ'TcijFe z.Ѣixε[M~|/Z?PDg81cP>JavK +Pg; ,ba'|㕋5IaR_Y.&x/bW8 9@$xĥ,~Ǹ.\ D &0nqcHxs^!Ⱦρ"[quq@>ݞF?u ￷CB K{ 2j@ -uCEƘoiaj"sXrS ;`ܻLjV쯜r%ȇ^sDK nSq`t0x.ۉFS?~./uHǾP~oOUX|^#'n G";ĔvR,T^KO/KD%ԡra_QezaV?rv)氫 c .c zZ~|F~bR+ɦuG1Bo j%V>uAl?%]ɈIJKQ7.W1[ɟ8y֡ӲٻᮕhEWB^a`_k6,Ҥsl'ݚM=%?/yӚ^\v}(ⶖs<;//u5yza4=C=䫻,? v qhU,Va?R VeG?V:X ]ce臘5b 򇄋 \`q09j8`ݔEA7^1Gl'uݥ{-Qאv/N<ڻEҩ8lP?Tmxy=hjg_: Slѩ8 ] ;Q8GϏy{sgR+IIsy|f-909SuݨIw_}Of9FM2Mh 6oB`d+zq&^mVsc <({yXnO-x/k*9[\۸[S4A|QuzS7qyHy72Jxc _>SVNx++(?}ċ95|ӢqH9qqMu|ixWIT"҂{50(fè:.''7z5߽' 2k/u(tn[ «zMe>*U0@T3)TĞ}@< Tv]1ͤS@egG*r]Pkgm*X}F0^^huw=jc:/KncϺr^ˁ 2B؟M@T0@;49㩋GuUass@[INo.Cǐϑ C,kyy͆Zށz?^H%(9ݏW>H'7Uz>'︄|OTi !ul j^lP[%R-x dȗHC|uG ZKy<8a PbjON 7} x3s8~}~JI'Piw׃IԵ!zKB[%zWx!#:-uG^9~9@udݐ糗տ!-iAk2.9?C< $;"w@E9>sV 83nWY WD咁Jw Tǰ:jY0P%v6^AqaRU>ӯ:@xT oS='ε}k2Ɔ\N@dAE9ft"K?;>ԌB-@ fjj@"rKq|^PLUZ5k⃳y@e}Մ-a>$:ϡy~Ѝ[⓿`xmuXM+}1Q ,٪ tU@i>*L.GMx5]VL:З"Μ?X/i~/*Nu5,_:3AoF[@w>]0 t-w@?[qca gk) 3VcrL67#wҭ!>3n}?cbӏ>GN/:1t{[ PI@;^?q8P/RŸ$Y\ t|?m 70Ol;_%ofO) >wȹPYW ng^caN 0u*пevM=0QGw_}F+u 0fضeP7o}J 1ln"`l=Υ {4nUrZTq9k`XM nGH#U;f/0(0˛#zZ0rJEڈkf]?J%Jk8]q?[8?00ZK)c#0,|#kۀ[Y #L MLʄn`a?ɫy Ἣ?1 ^>:@.%\u/NcpkgO)zƵR!q/PF'e֗y>?}@`~b&o[FkF 0  ;|F]7t oW~qč"61i9 LD\-ꆯUbgm]늼?fogSsKuy6g5;蘛00Q2[]ߕC3Tc5neRjg=P7N\(R~N`D,P+om9ẁPԚpo_6sHle<;QZ_Ĺ}}~Gn^>srk}f0#Mbȏh:[l}/D83Pʁ}SfAgSM){ Իc"9"4Soޒ fW}K߄ K7ฉw_yTEp9yﲿ屿^ vvR誁`2\30y/WUN%ǐOGzoɦ/ /C).]Oyvqd2g`Pu޸ta;O\.`2{4:3;/`х5>|vN<~6'sueyD6օ~7xu@Ż<@2;ʏ<ޝhWPdn7~qDN3 ~}cضۗv^Zb@_lꮠN5Yӈ)?};*~Z_0{-;Sk9QF?2,@&u8Uuq3jRv9*aJu!|ucI'âY˚ӜWWrq`S@,eĞu%/Z7ϻuGa  :w9Нl{h<V旨_{1ư4 {+(1-:B6Ҿ}>Y7+WcK[v(UX/TPwrU=ahq}<1+@~%7WZ;[S%؅u> PV{<:Yk_Zԋ96m$[M'M79Q:ؤ"-~":lM,V#LHʒ8fgQiKOm38,tôƕ>)f&Lb} a#k7m .Z>wѿC^@P!u~ea_~S5Cņc769(PGC]PP\ .=UXd\~];Ja=|a;ۏOw-_XinRWO!^.|  P~um0J`WԪ6s so\ \#~w%u Okg9Ƕ%k%0ʯ,%NoFgxtAY%`fȷ'ˌG%8 %7[FnF>~yz`<9#wy/g՜fN`>}̚hoƤ Njw׮|qz`o<0z n@>eV8MVz|]c^狊l/~䃡Fv|N?gj>c`t7hcM0L1j|@y;}I `Qs?`[0m{<9L;|[jӇb^|ӻni*`:&4 XԨ ϛ:hͽЯ *󤁥-XS$MVfokq^ 1&U/ ,s^_ NɓPM@nP9#$WY Qn#HEhMqދZj[oH2ǁtKx7CHNW7Iߔ@KI?od-Hsݭw]UY@6|֖d.Ǥ-CPgcdx/禬+?Wa/~ '90'jyfN9l"( ~D ;|am= WoOA2aHARI yi^2/vWlX:י$/uNE2sJp`x׉e. dt~UIV\PG0dhŃ=>+eؤW+kY_,Iy 䵜\ K@$˭NEY yT @f\u*G6ݎ:Lr3ȳ0$U~K9q8lZŃTKx~1TaϗBrsM [$j> ެ;0['. #׮+'zvN>mpl djxd|u^/T>3-џ1Q&8+}eҞyTȘ:74EqX<iA4uٹh,}Bttw G:sa~6)Ꝙحd'XG><~pXp;?WJx S W k~Šs)7+ܥH >IMZ@NiiC$;ޅn4sxf-5>_;f;Fg,[]*_2$leȪgy+l.o~B*-<ݠ.Acbq1 wW,R|Ws6N]#{]cJo?lfYxmY,Y>\[_ROJ.\g|x@7M\Cv ]Q| P[Hj Ac>{㼹n@K G?Kdj ~'@.0N5s5".IefB e+|oʗ;ˤ}@җ:C~%>$rN׊uwmܦD cGMx'O~ gk#0._9qU`>glļu\W:' s~N SjOcڅs9㳹u*Xi/W[Fdđ`ns qH!)㩊ORR$CȔ2LmRJ%@y,DiB)4G Q*TB9 Iu[{}g}^.̅uqp@ 18(I5o|+y}݋ AÙqw>:@>`FA{D,a%quQAЩ} {}&oZg>yL2Cú'y{@R"\K{Sؾ|\a|.xB Q-xȻv%׆GO c9؇+}.~InkX#Q|o"7qo$Ee1SR׆0~p1]NS.a# 5ͨEe#xr*G0DNY(j^m=B k5!y !8.ZklYC(q!JD'ƃ„= wRGY 9dH(=3K K/B/,H(L+-g,M~ܩyDPkr3p 0u/?\s"k}MB-/-: 9_ B%0r|Oe~o'֜R>JnN==ծKM]s\OL ;h xK(˽%{fhI(λ2Fv |`-bD3'1h.L3 ThȂK9|)PBM'T]a)1}V "TDq!BU޴sƲm%&lb}ົn{x@W%ፄr,kj@Bmp_=T LVPa B<6O$]jMlZ 3 eǽ뺕d={*!䟬M;Xrλ|NX.W\ h.!T`IBywE"[&Bm﵍ L$nݪY*ȝ]П^a=;=0k#zŰssj`k-4F>`V;nϹ;!Op?}y6XŤ8.2Cի |?h0ĭU\=κ?TSgڂ?>6oKM]3䅎N'\ւ\Q9 a`y,|TvGTjL:~L|78|c% U_fO漦%H+ǭA\ ~"VzN #LOLԁIxWv ~Ah7}o+c~a],w~ E[ g-rbQN.3¸dʝ3Y4%OGm\/Ou'yW3w=k(ӗ?[ɄpVx(*o{w:<%a*|ܲuzڲ5Kƙ}ggr🍒R:GUAϢ bS߷[^7'R{(W'-j/n\Trbn]3G)Q}iO>eσik<-.( >X oN,Pat8گE. 6T7Y B(δ3 yEn~%B 0n'|*-ĥ9Rkc cU>Z:}^ւjX#xo٭uQ!BIا\սG2Iq!Xf:W8!9 ǸgX ` ߷Փ!N_DSXVo}"S&GWΒHLfY4垯{O:d2 GR cw|N =b^wYm[P'Olw{o#QP׽U& zvBK<? b=;XunQTo </@W: o yCd Awʜ/fӲlpwϡn`s&5{h+Ƀ7m}`a/6nP}a|eŭwsYKuvM8ȣ+"DzFٛ`[ue=Ʊ,e떱V-¬dzŰ/.%ow7 HP?\Zc[~ŌNl| %)fG=Թ6A<^ȝ^ŜϠrxmG5W2PE }4WXy LP-0?uC ^˨ߝyH=[zA\75|ةkO`=( o/VwFWnC|S%M<+J5P|p)Um>RS,umoG:.KO3a`',42`Adڄgۗ nLOQ۪mMGD拄Zuf#%Oxȹ.-7VpeJ(&o-vLbsCKMv6}&%':KPsd[|Я LlM(gO%uО;ܛ>ex}\h&M(߱`_^O{-Q ̇8Wf N3!7Mp#Ԟ;.O9r*u|A99?M#tDf4AyZ{w*!ѝba~.ꌖe@|ʳXgs*ۋW&jGK:B79d4@;4ߝPD.z`V8.}sPz|B~ғƧ&fz PqF ura.ܷcEF^;+m&3B2e.BpeOVB]j0 w8͇~Uw }x1$Ho%ŪW'M30ocakTg`|{d,B)^&Tˣ+hxք~aԇmy]ܑGL_~  T@{bP3=]e@ q]uB1w/zBs(z:מtBϸ}7?lww }"|\>_'?P8 B .*>Zda=BOXzb9%$R/!6TXi$0F O{m2;Pٹ?mgٌQB\qJ#qRu6?_+֘Ж&k mQ>*C:ϖ&mOW[ H$vyqaBU`:KiA3A4Y= KGP_:Dnj#L2& A~tBT UjiM_H8Hy;c+>Fkv>Z=w|%z>Bk;wZ(83Bh~sꄖ y20DEZ2̧-BHWy91ʝS >YP]NTaiwa%|4z=)N*CUPZ#0 ~xD/9 88є#qFgǦCb|m C~zt$ hrvPF_Z3]۷L%Or;B WbO 7;o}^퍺 Z|sƺńq9|~isy%rC#K  ypGbZ8g63vs6˭ҏ~ l+G&C7S OgfRe]uƙzBϰ> ~oYw'"g,-y˗SmJ_2ux?C>wkeo/6Zz ,?J}v>7Cm BNg;3wq-[3)Rm!_gыRXG]!6_Qy#ׄ E]a?l|zRgWW6K+/_x3 M̆u{9WL[i"Po].\=A>oζ;ǂzB˾rf~!]z%ńiײ]-ƛ@]aB3T) "ڬ}iϝ;M8UxU_Nzg89_vߚɣf[HK;ҫ-% hk9c_=دTu> C[=0?# 4>W S1Ɋmܬ =N}] qcW?Iq[8^^~i };a[Lz uOO yn}o"ddmG(݌ɤf _xݴDcW}~Byfc9Ɵ ,<tuY&5]iknOwZֽʥ<.ѓGeRoﲊwЖza_iz֫5j*K NUB巾l}ܗ־P>n~S+|=Ou|?.+|p'] b6}ۧeE<- Jzvs'LD _3k&aOwz+mmx>`aFCAJOH\:F ALlJZ5c৚Ox:<\*~Hts97˫+B m]$#qgh+u%T:? _qMuG6W|㶸_O|) 7%zr4Y[9/h!~j&wW_DhG~4Xy|/_dBvByڨБé :tK ;;=9T o}@hE] l;ׂ/ܠz7]ZmB]w"Q[r3US{خe@\vHU MgW ]]+m021"yq9Dϳ5cRy#tg*i\6uoU\R+>_Iwߩb}/mbӭGn.CǷnuW%úx&k۱ЏwLy\$1.`Hhj}9+#k-gT0ar?0–S,'L"C)U=ɑ/ҨKb+ s|>apUci2wa'Jމ tr߽0]6c{xdsa[70=w Bv~03xyy>aˈ<! ǚ!'z0# ZO'善ɳeߪfgW Iyie/_l/&ljܷG-p?_t=zfOq)aœUar\r-#h3S~vɄl9Kw$z%zœA{\{b 0zm皋$b˼t0Z~x{0$.\od\a[qr̯F0?aZ潢m֚4WI0}uaoK\DqyC?IGA; gx,#jn?7_x}UZ2D[NqxŬPVOxYg*!h!%/h ߫ ߧ|_<_wW#|KPP0"M!q D~<SSS>sLg䙥s#?2G"?rӑa  ?:fE1'̑??sO2 )cԟ:T?W ;v&v]6l4~&hC~K݃<[g(#?#1?y.9乢zg-ȯDLy3O׹;ȯA~3Kpg"oyo;[ oQ򛬐܄[!:VL o}yk6Pyۓ#oy{Է?gtw8$o=6䷽GK߾owTFIbwjD~"wD!ϐwB%y:](nȻ=B}Bᅼ}=tGʐ%/'!7 yߨoe'D>p#f#8|z. 3wRF>,Cȇ ~(A>8}ȇ")ȇw#|D2P?(u#Պwx䣛QD>Vcw!ݲ@>."" O>r!;P-bΡlXojEK/YoY``֘[Cڋ98+80b<ٮ~!!t9yG0z3TAkowi+`oi wNq t Q; N_h.9@ZCMZ]Gor=5mx+%Z k(8~d2yfPortfolio/data/LPP2005.RET.rda0000644000176200001440000006535314254636366015424 0ustar liggesusersdw8lZd+7{NddT"JTDLd%i !Y ?s}߯q}㼏DJŠ|ov?މvJ=##Qaa !u3}Q~TH=*mt@ICц'y 0)3-ʷ%~KD/O_M QkK@MqO0bKQ#p|ܳdS> ]t(b dz \2 ơT;sӦw~*_#ˆKQ_}qT.ؔLւ| &Q<8؍߶.Zƽo6+v3j8@03x5`U[ܞQ+ yN9(5Req5'B?iozU2U ~1g*ǰة ]2n@:jNf[˽BEq5y\6"lc2+~ - ?@kDm"]@;:$wPu5d'Aԍh!%B/9SfT<gVCܵ(!fPOqnm5DܠuPn'n5T;'wЁkWT5gN#Uo1_ ?)|()6=V0R>iaYrFgVRHeo/")H+?>ִJ_jq׊,ژ .xb7QQZ 4;SM qύўWudPMfh l^e!¾xt9 6[Ksf.׉Mfo4P\#-=}-Y+_Ňx07@((eYO3 i(w"*\="Rw3Tѧ\K?ꍊ!(8 m)_Y]* `Q^?XMv̪ [3!y.ptΜy=ՠ :]eݧVPP8T+&Xu=Os TW Y^T^ۯ`y{L\VfOG?Ib~$ ԞO,AHG\+_8ʴ܏W<[hFxEW^=/WmB._&̹JTN'8u^53PuƥhtUƅٸ,{J<6{L\^sx>G-bqds}a\=NvFi2{QlF9] }/Ф9K)0vH+&˅[@KK\=b% Q&ۇ{`XC:!BړAAޓlu49fp ^-Ff[I`^{}/ ׯjנ$[4)6,* H+day'ZJZ#+Akzw&?B%i,Vg|^<-xKV#nR>zY^4#M}z/"W#Y Ψr3t~6~]x{<{vnx_/q8ayc`O\.<w>)RnrHM[f:tBmOha2 ϷQ#0S2  BpM: ~ )Q)Ʉ@9E׍unz G C:ЌL!e̤v暶jqf-N~5Nq/@G6&MiUBGvWFZ|HlfZ㩻Vj3PYM0au9޶L>];슃hPw()8vrLd+50i& Y^Pg; $:{(?nQN^-n}eMpͤߺ 3`? ƉQ[Jŀd:ժ܁E( MzOSn m"j{Tht)aۙR?eA\[o*8pI4(QW }n QD3/Ɔxr$)6~8chc⡇2d֓`VXtu リ/D6q8]=\* =V9x3KVnZZw{il}avǛ-vg3!npؠEt3`K+H~YC}#g9~-2 ٩2Z&0 Ԫbf?zUmiBpi|ZxS^r>1?EуY H<&nRAW-7.v?qlwd}[!. }ͮ. JFcL^H dхnAԑǥV~B|H %uR3u`<+^ћ.`gj޵:`dSz߇2Wc!Ja<,dk^=k :Dq7┐{˄!J<^ڹDD,cFCn$M[?*<`]ӬbB̛ ;̜Q)=lZB"|/Юȭ@?)a4F}kﱆ rK 쇡z̊~ S{-S1$ {~))`\hp> &c@:>wf5~q˚; [4/Kڨ{ -(J@ ̑K6, n简Gsx&,1|ޭtr{ïHS>M6/, X'AE8R0+/b' U"E/f}TCWރ3/lKԿ PHCDxč{NE}@>J;<_x3 \uJC m)5$u1H9A`yϿѽL(dj l7>o5 x_wQ?cԣ^3!me_rȽ {|_~7'T1:DJ[Kc$^j\6=B8RbI|LWԥlA`ƽ?bg13#P^J>zR w&iT'X)j!/&!S3BҙX{XDR_8)OR,."9y|.dН İfgl`ۙ.q|T]8>dY?-r<xtfOKكWѫqHE x7SMgIY/Btؓ>PŜQ\Ji!Ti QgY"K}6rOBlFƁu7Wd3C契QpVkҜ:cʛݙdkPb:pZmz%dAK>~V5X2S=xR g>΅Xu]ComN*zcW?תex~_!~9Kt7celV)dޥB BG)hEhqn=ӗ}z[Q}uzǣ0xS~fKU;t|`D+-U>B/ZRYׄM Yԋ:? ߷OYdw6zstKaVy̥*&OØʐF&7_8ycCN1Tm FГPĻ\V/<9ѽB~#\y]v2`t3Ҫls-5iN m':D(0x3< ;{y:ԧgTGƕhBM( k>cnk_ъAkB4\=Ӗ-ZtS8ƙ[']it!^3>=!Z=QӥoPߘvΧfh:0Y$x?& `y>B&H O}BLg.*no)&=߸1WDY(aЫރ2}0&-=,+VNgR@(L }zÂ0͘n:K~=dA#gѫCkHEaNTafQ~1s/)u@[afS~x.ˀĥA3CԁyLrs|ƧodDYھQ0I9[yWg `չ3ɰƒ'v4hɇ~gɟj`ΛI }}}"l24zfϔIGd$/&yl2 `Dc.:|=nխ|r`Fs+i6S;D=KG&v̑zJÜt1MyA#,Xo}\ζ71ICUQ-4d,~hS)is\_6J?BJiP=d&:nKt8T/NA :tC=fbS[P#m#-ٶFxЅlVӣ m 1'/HuI>&V8 ɋ~:r:a>ZL)Q繡zpzSa][o[U|f1+ c$vT6U^ UxyExG]?FDyPT+jX:yd@.DvB)#_+<Euni%70=+j#kA eJh_a$j0`f^d*8Y/kv}<-bAnb6 8x}Q3F5VeptHA`1vW-ms͠S(أqB,co#2`p@:& G|q՘Vdz$W#ş:&$5]<( !J8}@ܫ:iO5N?ni=2TD'Dv-xǟG.Sƾ/!>h>ז׻wYk/sԎeJTtWki,[]N-  hJ-N k'0hs{sdREoڦnnK.=G=1^D4t Z\FN4}prsRJrZ2!s74|ѰŅbou%卅}xG_҉@;fyX*at2ޫŠw~7X5ς$/<2f u,kLg{*p^t֍Kw4n"h nPY)+v[#MýW@85.TJ 6^s7s33b]+RI>BrM];'o'/z0N2_VmܷV2k(=}Vb2-H4t$)lȎ ['Q][8Aa|oH8^3w5uP~MquDٍPƒrИۮ9Y% zW@mwHS<+ ߮_rz<<' q=+sèzdR.L;8,>jIΞnlSh:܆)^ CxZxOW7!n [l~J7ֶ_~=@55g>yuIޠ@f/?W5ݗabA=VD3)/B~#u 66h! =ye:7 J83S@ '+D=~YPs$ͬ[@TCSjNCkmW׵8?u`.cP~Pv(1Z7*4&C:4f,;hlV}OkMnIHy}ʹ}%ahzuځ?*_:l|LcЩɂ׿XgudPp9 |j!Ѣs4h &.9epC9sAoİU# r cаr^魒+$&([wc$ ]ORmRhsUHOp.{s 2.]Pvm{ <(hjM KA{<]w1vbOvyփr zPXuGiAJs4͉Ϩ|L1J>3f<.<pZ}#`p.( SE w{Wvf|fEjda}$~m}"hdD5T;2[ 7ꃈf 9x*O{f{nR_m ˼5Do )SE)Һ]:NhuD!%m.ʏ >iZ͟ĪgK+B)g.p%7!ҿb ?ѣ,=C(~5L sI:qOTim$BnYp`M,sJ&MOC޴7E(!=KHm ?;DTvIV8*zF%{~,HBfMjwU=!0x P<:59lvC`!*2ki[z*(:: j$ =㌧AITP џx5:Нzz[amlb=EKBw>uYd}%ѷ@S@zy,ZF{4C~ c_NMɾ$=h|}<֌ӃLrQ7ԣ-iUr'/@+G\=vۋ4\^ >G]F@`r4&%{ t߹?N~$a0=\Tlu_V`$*U%zq ہ[nɮHo-]q>."ѡsX l1hv]&LҊ5:-,J|6COWQ+R纸}'lEg^W,,hqf.8;$PmT2eEiJp l3J ׫#z\ G9 (o%K^CP[I4 &Ckf()DK:d{ޫEGqQMU9Jh+NN1 Bb~|^~7IFԩ l`tJ=Nq\Z^{EyNE ]J W[K" C&mrV"O>Ƃ_Fu.yFsS<Ͻ| L˯,glc8sn(YǿN񤯁Vv5 D04nׇhKF zx}AG\]REs5%CE?yI~zEϷ5z+.#L8NN*ibO^i5EDz u'd~/zhhXSpQ׊ =圮Y`d΅>9AL@e2>7;>Ff!43> KcGt QJgs~0>56€E/gۣM/ MHӊNDkG TY0<2ǜٯ}?Ec0ܯ5tp_X-PIh*-2HeJr.ݰ0'~ *gOVSq=xk^-<f/nOv]y#$p~< V#~Xѕbfq0Vu Ki'cxy jr hZ1@)OM _ h?Be*A24;{Nf%~f3Ͽ_2+S=&2Cx he֯|3X}l  Cc!6qJ![ݙ9`y߫tws#zζE`? ܘT\]iSH%rKMROC! `wie'>1zcpˮpޒƐ\Ù>+XmzBk.>}ɚgi椹6!.BSDqwEdo%m xAr3[ֱyr`z6U޾埀9DBxB[zN+JcYx)7Ј@ m->A͊.稓kYn.jB) O:Ӈ;c9gx cy),?]ÃԱT)]/~TǺ q*J~hou$$kiba,}|HK7|4:r!Mg^\P҃/ipL&)wyYV@SgzB>W`s/H+0=V$P`͎:VWy ^i.d/+ݞwʾg"՚"?bԕΚly&֏q{W iA YE%3(*AM2˘Q%NKʦA+?v|頰ͪ!zmaQTt T(t k[j^`XF0Q )|; 7u@q#`b_l<~7V9(.Z|96ޠo#~zvd-Np'O*c,ock^743ޙ"Cq BpNz?DKwȹ/@"[XF{H3exAvblg< Rw;Ƹw?ҽSRt}fOtܭǢU.3dN<ɎBkxsxqK=Hn2cI+^(C Ge0_v`z|8p2x6yșG!#&RI\.ޜP'ʸ)sFMMpƦ)ykciDw:9┓oYIG>L~tjoO?ak?^>*?cl\U'[!J-8ھ憒WW\܏{Dko 8 2]w8Sd:Uń Tj][5?؉iK= \!O$.`ԛQH19I1Ud?ԋ:1B`L#!n#T 3П]q l4:FZ!?9[H D\ LIN1f0M, VJXBu2Dbn3!xG練@6)~g}U(埡۫D{LNwJɿYoTFwڹ-KCRv ~AwgWBOpMv[fsV WG乒+rG񭆩"8_eX}gw:r Vr%; UH~TT~o!;M8 #*[| Oi0x(MvvVVɟy93RtyzHVHޝB=^*XZ/hU3*̑>g cj}]B>(L *dK#㴦ݬT}e aHÑ_yUk\p__I=#GvWB9R!jHX<~B˗;^vB w{R1 3m?u<~Ss$ pDoLN0*_ I0&hk I&+`*mAϡ??߱'g9`hZܚ[>D`Ń_r+c ,")?f"Dzvft*0A7P%<i;cƸ%ļ}Y _u$ލƨfJۓ6\|*梟d:.d3RS5)'MOPӕ+*`Bc:#nC-*I!s+< rJу}tC y9KU?G,ت[8` {q{5 Ype6P䀝W?_d( al|WK?^PUɉ`䋥;/3?b\1в8&$"ZT>WuIpZ蒽 >,Y4Wbk1c{B/wHKH/J @"K^ :sL,}ƌڅT{=cMR>"[{0߻F<,T5$wR -D/$U'+Zw\}M_b|s_qwU$KHȮ۾ƾe0ƾ&;QJT%K}ډhU%5z\wc3/3֯Z:E{ owCʓ'ND$\wHxhS;v@؍iWï(1{7eP:E]ļ_y| ֠ȐVn W} ,́/C\Ʃ1J4##oҏegYFܾV n0"7i6͈BLt$c[t, wkgCR%ui㆘IH1u]!x\L BxWJ 65uxT"g*; [u締R7>Ad^Sj |Py^ʯ- o K;O!JNS_\z~9/*8W<<DឭF+G`ݓѮ`SoZ z7r*7 ]L^YK,h-/iY#'#ҟ /;EePb&JT;h%yOc";!GcѶkrA כ(7t" xw|S,:ijM*ֻ#_>W KLiU|ҊkVb8 ~v+@*olE쿩lwTQk2 K֎!HݪPF nWzy az[f osw'gBv~@xVԽSȫ^i¸( 0;1NFApѕ][=Qd>p}ØREwq G; 6' ?jZMK4ڳM.ɓ0}]MZ^'5p.g(t^݊2Ck{ ̒&bq4`-s&d-ny,Lx>l@Y1֔>]6V]CRw't>p vIz={/UͮU:k}Ce{>ωrC7 wqt.".Ҿ^5*WȜa(KR }ACd{̅{)D5܁}:FJ5DũM @:8A汇ȳk1,߱ 艱[;]Χ&42o:7 pOZDQ? qIH$?W8U59-fg*>EB^gT!)q|{iRm1c]<>+_uzi WaU2(yɠ-׋(SUrNbw#)E]9dg7U}| P(t?F*/G؃Rlٜݽa>~U ]̈bzF{LZ zOu`+UK2J}v"O]ȿICvW[~e>K?u2gNfgH2}ޟt>PBgʯc#~V@5 N#ϑ+֑b?^ >Fb+ͩ[m"`sb9X$~hD9W ϱ^0@Jc3qɒ 9!t &]AނtG^anj#MHF֭3umnrzb.Oï}|(cٵ3@pqwݢ>"f9}N@nt )63>s ydE܋9i<R2*|_F΂[`5P-2O^7:+҃q/-u%ءrlyV\[AAL+ Vi~C3K ?<""ޡ8$v1, z5*$f.E[{yDڞ |. wTt0dCҵzgi!ͷQ/~߻8Upώu4jH\0..# BУܧ÷ε!8R|# Ql˫/ꩫu#(һgY. } H{wxϻ zRMk#(0y{idk;x~p| v:InC@GsU=.ooE{<'cەdޮozd_0ę-qыL9s2"<"ރU/E7ޞs^ީ]O(jLJ>(z'T- { sAw90A f; g+yn K j ptP9IrǼ@w9~uY{`W!׈#HC"J#}͐OFѤ2:c^ffAO!CLB`u*= l?^J3v !uAno{"Ⱦ(+75GRmSM rF9 ^V/ 3ԭ>9D$jXR6Q vW]ίN3t{x#eNg0<޵nvlzd5|Ӽ"«2}2s/[D5 +8r蝜z.~}/!dċkum;A.挏l, 8-Z{E1 j(0I:6N|e(2tڙ2ٛAȳ9KhԨW"tq}Ȏhpa? xYFbe+A)]Z ޕyk{V/ql!ăÃ};AH!?ETRzF+ĕUU!;7 ,@|(|{Ψ8O@1ky2HR<]+lBdė7H?pAA*:N]X) ̜{^P/d>v ]si4px.j-1 wLQ%C1!==^/Sn< 7KM/=K`KnKA ŶD6;WXqՅRIituMVcy^g&q3p`9؝5@I@}ν,dk R/fJ:%D9 6'.qXrg.J0(dɛM>ڑYC"cird#䢩|&q wgO4?bX%!g{ ݱvolKpkA d.R\}Δ<ڈG9A'жq !%&8u7x;w\\HY6+0{%C$?D6]/Z7l6[ <1*qN!똑G#7pr]Ue|rntM松Ȗg.]Z 9QR DrK7wc"UTvb'/@NLPy2<җ׽Wzeq9&OnA>"e b;y ysE8Bl7ymSkGSGz57;:Ry :(me.J "U(E̅v .Vt Kg nequ%g`(VrW# ͢E IԲS5>^~9y .<{+ O((q`4AE}0B-Ptvd2UןFdǷzJ==6oٓG".BJ C-`rF)BT:=Lt&Dίƥ$zbR$Q@Lp7uvp:%83yae?DžlELD*ߜ]m[#*skd 5 >mj]H`(b?ayK~FJlG6J~Bs^pC!M@ sJ|јL3x ODNH٩=rvB Y6xr+"&~%9cxeg<VGƫM`A ?4v8!6?*+S2v@^w@᷒58Y3UStGMc[D2^k8"[Ax:Q ( Uw^[>-?3{#V`yO]C.Qn}UC>c$?vN QWnLp!PfIpFmk>(_DȮGm-p 3_j! %)~\HLsY]mE y0^Ȝ4F$[oiIPo o Mcyn>34sYդJ5x H?\OSNW@b}(m( { O&2#vK`bIr^Km4!g>0̮}~ՌNZ:X4[ZMv֞~"8 T CZ㌼`2x2k?*n֕pl&p]IAW_,duVvf{7T,G'ۮ2jۤ<%%GXSkaH7.z1rI\z4{4RߙCsZ!*:X _j? !oVZ*Hzqţb0 n?+( i%W!S€T)˻S!b8 ZH}Xa,/ ۂzn M/B Oh8>M_]OXhd!Wԣ(lso;PnL/\۾g/J s eͮw%M^֕@jn?D"o[o6\ S.2N!בbs{;U!{Kc#@0ۙˎBer'0WZxich&Rck4ݻv"qln>\Yc=V a=xQ8?U_J?gё7s( @u ,LGcl>ֹqp]o"Ϝ<} )p᛾ Ze]:fs)5 )d(0Q'[~:SCIoeY> lK{n#5]st5MG#vҺ3ȑ+kysxK0UʝѭHn=IĤsՆ" +@tEvCʅϪ p{F<[1ŗܼ ![R z4VڛQ O xr( {y=Dvs$' X& Y@\~ V)$&/@qO\R1CCA?#^|rdO!h#?ܵgU5ߕހIM'a-`bK9W ҟl‘oPP JŻȈ~G[02:wH|_ CCChY٨W˿*g}v(V+r߬y,I)0aT MN"P_PZ $3Mk}u;0Wz-WkKG!XjvYpp{yy@E_>9jƉ\@Il萃>}ɵ#6 $~=lMg1dEB4{l]9nrv<1U# Ȍc::eKMkiioZ S dA:$MKE >QL,t̶JFmZM[tЁ 2R lZ<YXgr  asp0 $ 7=D{+OXBxP>RD̚8ހ""d}-@yJaԭqH{:/wh#ƣ`y 3frً3;Be;E:t<ɲ|I)&w#=Gp C.@Y18|y[Vu 2 =wY@n۲9S\zYM҇z*@S P!X[  xs{A65R*pz)Ƚs~e.R8'lK| Ǟ;\//'\W> dxgJ4WOîOhwCvnw_W/c%z.0Z@ՈT2e2N-Dt@grj ʷu+|[{2]?a k͋ecvp]k=φ"/Wek @})BX{v!$]|tB3j@|[|C,wo IDLwX!ErO=ңwl@POg@B@r\ }پVtIMn(tFutC\EQ.| Jͮft~;; }uAP$z\C-YE1[i!*ԓYn3>2!vSpd8Edxƺ( 4k1WDeX  *wGkCZ }@"x vyi]mavҏ+)z'rF?Kzg!H%A¾|5Ax T-kz ' n͚6Cz\,ľh0~3;C'l> ,P@Dwku6#I.o#8%\֫(Ϗ@DQ1o?8*?=K{آ@.?/qm(g*v #]zJrHHK{N:3CS,-#XpBfk@{xTc`&<8-yS1>iu _Sܦ!![4 $Ǚ1`?'rmkNU)pc>AK3%H* 03 A6ۋϞb&4^\,;pHVD?Jt`;syyLEc@bON柲=7yl 4rQg!XAr0 t8ƃNb'o{C^@>\A;5 [ib]7p~-N^ (GOPBҽj(9-^!|#@`si]Q^GQRGDG*{/R[+z 0)8 ;$ ЈT$z[$l6{ͱ8x}`:p؎l=]sqaD ycx`S/HFɱDb2sSs,d)U,&_#SV&EC620Po [qbG`σ^E,haϢEY?('ʲZ)PrT`Ea _?g}z9>{KC#/ߝBٟc?08h)2~ O`~a쇏a0<Ǐ؏O ^Jb5d?1Q{'8\hc;p0<~'86SO`?ՂM?Â73ױe'Zc?Ο~~_vJ /cdR K/`Wc26G4:xӪ u)`O=]?eJc* }3$|g3 c=cL8y̑3aq',q> {{سra=[ gk~;Hojž߼^oǞ{Nz=췬~#[q*.ae=9Umssc}{YO|Cy=wy_Ğ{|]*~8_@{Lb/(J^»ދH^T{XE;kyG^|^[ c/%b^{Fp 2a/{9:/焽%i'``c5gW*J?W6^ثL|U}UW^M{u-~{kh`q{8_=ZJk^k{w8dt{Iu|du_`'^"q8_ Dco{6o{0`o̍VomM97 ޜ{soͯcoq [2`o醽UcoMz{{mmpm%ޮ{8~{1 ;|;q {'m5qs#ػar{\:nػcއ=H5{|$콞aOw g>cmޏ=I\s|@[`>}=y#d/`z]}:CVq>= {؇Y 汧cO=}x)>G>Ώ죎bh-cq~L>1U>67}ǿ> O>1W'~(ߛn쓅O~_^S±Oy}} `8?f37a}g5`W?,3W".R")FP}Rh)?pelI Et4o4^7"b_}C##~Qkhr{J9*M )$~{RoD4V0hV{k !o///.,Ikm\]k0׺F2P}H޸9O_ 6yfPortfolio/data/SPISECTOR.RET.rda0000644000176200001440000047367514254636366016047 0ustar liggesusers4\y )P 4ޔWOA˶yUg4NPR H=Oq_ %NjAt|$$$hAo4[N_eqb` offK%hoK~4Ђ*GcOZ϶η Jp r'}v=lk;0ۥiU#A \.Əs7A3&(qg--0%٧q-&'*4_Zf"SC~w'hgX"qX`SA)\7&It]߹o֍h3KÈW~y]'X6]|ťx[}"\sJP W?fa/M:oɄ; ? ֩&w]}#[wl&(fG؋{`?ۀu2Kfn3o (_? =Qpcc;7[öJuasoOt Tp'(u\޲lnl_%Sc]v] 7 9|wN SѭXwfV†iȳ /=K߆ϕʋt&p_EL77v(*&hu%Z $hbϽ{ gsYji'O"`&-ŝ?ŮY >x4P2oz þ$(bBiO+ Llb_>~vγ#(!T.:c_IP,, W1]䞳ֽ{\uLXg CeGGs͉/`ucQm)vN<7;ts=+qo5j֌Dltϱw]1߬a!So J |9huanI[qwFg|Ч\&]w/0ZD }Fso(t|ﮝh_"hֿs^oE|Fͤ{䅿hg79bTC93g!pax;؋Y'?Az8 ;i%?Zz wGqOx;O`]1<ZUӗ/"x[nryp)x J{)&?N5߅iR1}e&y" +ۢz۴Wh<ﭻG4nreGg'hQR+'#1-% Y||7ź3&oEߛ WQlVlJ:Ux"O>j'i0^"ED x?WKܽmc)5+xq}6֩w՞{-o _o` t#g*?=wlKh# w^(ؕIτaHq&'QNzuKL3ƧkjIPtO+n 6?|讝OS;kq_]1L1%?2]|`gVI-cl*˃%r__묝?/V;0~[ R4~yP'^(ZCBW=vIPΈ7R89,u4_aZvXί2رG=Qw菰^Wg7|]|ǨAjС^JZ5O"g-onכHQcGF>yEyϐҮ0M+^ԂZ.=9;/r5=y\x|+)z ?NHoQljTīHl͏k YGxĊNդHPPVQGtt^]UYP/9O#uKCքJkX6\-0z pש9o?&ƇJ`W"K9}l{iKyӨ_ϵX,`#Yun;~-|v8!鐶/gD)Nt$ƞ? Z  } q|P҃q9Xyd&Bp0Iѻ9g:SЩg*CGd-V"?Hď{­lag^*Ӯ {-Mt~%uNtºoVagMX*Hkzq3xOw&h öDŽKMhlE=d篏z(tf_)?s^C[2pQ:_X-xZ)J#hR7_f>wq >j>HctMkVV͙#[z(>Q8>KU_SdҨ|Z\Mɧ.rq}y+Kȅ{$Z68nz7Nd<>F[w  A'Ϝ( (?vn~ B9'?e tgho)0MWyVAESN~sX$i<]w+kiym(~Aoit! >y{] i/&Cko>`'/Z~FIs59H;un(z+v7UˏOӣc.@s< j5x:kG՜{Q'T/onnIť<tO^#z]binSo¯ޘ[]xouN[ QdzFN_C>V&Rqhyw~h, ~3,)ܙ;OYnż9rsZ[A+>&C||?A97 AcrWsG}+iG_^ >|Tڅ6.8Ly⍛Zv7TJWM೚)!TZD$7Ew>רr*lc5:osP*|3yfA_z/;POYr46ƼUáv _kGf*%qU C$o)H"P% )}C)Kh)Z zjqعLJb%#Bgx਒\qh9pmZE8_+>&|n|-b/r ~ylYK?upѳ=x8nS4X>;ga2kor_[O/_)6 _EN1on 87Es 8:p*]^SƀJp^!(B=o2kPubClㄶLwyۈ(T$Z<;~0ley) yÈ3BG˙GwG?]?˯:/+Xm&?{?CӈG!o]eV=L>)>$_1? /^o>ڡ>e;z.8VdlaKsZZS~nv(2{3sb(7wIaMo{/:?nXn->zuk /WTl@~e{u!na:i})Ij>.1z6vmȕM_ i?[v;XRA9Vߩ}ʐr=uK7Tn~*Au7a"i,BF6ς߾NyD OT /d1\̦"){I}!|~io2@k q?A:1?5'k`X';~1~-B``C}h{Y^JM%9IX&_iGz<Nw}qAP%4߷GK [M䕔Q 2탯=1ݩ\넃 !|ZQ{Q7x#wqS{nfk )ºt>-JߡNFm |~ ]MZB|Yn_+" ?82OgKYwoXM>Q%['Q 9̭3?>}6O߯GB_I)F_Ӵ#HoO5Ǖ=crS!C' \pdܕ?p%#Y?Qn=C!omn9] m㈏뜅YࣔnsuO+%u6PkǘÂq.:nk\|+ug}wawNO3$/=p~|_k}SC6N˟{7@O߇P_yc5]B""/` nVr!`q[%c)h7 `ibFSN>n3_Ds=AX׮o ui=7=g*X}N>PXysvybw;"JWI#;i店_ e =#auη\W|l_PEJRm4 9˙|n q3A;I>Ȫ^>~7_gȧMsZ}?HlV+AϻF聝?vNU1kQn% :;EyC=KT4CAx^|Oy8Ρ.?H’<= 'B?N[s2.[aQC IV~v :fkx'uGIg^L=2$s}Y6yqO5P 2/keyw X$\Y4f> ,\ bxܑ&K `cpT95 XNJpeQy|3E(Q}-o^''VM\:H>OHH^p%O'[k/i$5-]|<'\PI1xGiCl1??ܝT^^}&ޗi69JwjEff|6:3;ޢwu#vyJ!݁ gN9}n8x/16qDO4)ϥ>m qawx#Ցmԉ(yF(+qx2z2n- }F_I{ƞx|wQߌuNJl#e4`KCaXGޫN*B?jBZݜ+~F{ao[z#Ċ}u(}Y`['F[K3i?ܕ Qk}8G;+sx>7y.Ao9%>G< r֝]rɾ^l<敀z[zܮ yt~&6Nc^4W;O;lEy&乖ϼCgg6M^1'r3[KaI\籾@Q: ~s+u\ICi"Gs }*N,> ̷ C v]2o,iD<ՆI_uSR_G'#>"}?Xdw,Ӡv⦲y;+Y/Tr+J+0K`!xә|^$S {.y=ECXg؟mVxcҁ]૏rkv,_q.$t.Ա:E,xMm>|7#goZfYy?]eSɡOסµ GTTp /F|q)CB]/OE 坘D01_3!mzHR}_rs&,ob@Mk:4x[)΁V#=_|M%XPsFOC] ii>/Z %})Z͖ld K)/W!{%O5T~孧5fig_ .Z @=[K ~H=r+fp@8~Y\E5ĕsTlDy5'IAgEJ_֓uٻ)Imˆg4$ÎoeF^k3e/署|$YҮ QO#6~LnE_oص^lBCL[pXzܧՀ:%nu{Lĉ=' <>܊|l*b h~~uO+AFuA]-?wh4|n>{ͲM|s'pd{fǧ56yNƣgN$5x00!י045uc%4SRedvZRw+{*_B Dàb|b>'7|6 Xؑ}M%O\:YnKz4R~dW߬{drM 7%3p;*3mnVr' oz.'UBۥķ3#OOwUZO{c=VvS! Q+/_B'IShT_2~8fl2Є<ۧ::x@&SҍT3(ha/ƞ~y賃ooa'' <9ɫ]Y8>q{{0NEiWY/O/v?_?GH~>ʶGP>x_Np[x^ka|1rtv'd_蚘ZLZ '?'NqI7f/cG'T%+I}OhJ|"P.]Ǻ]9$4#uczs񻏵6b1K>?g/g0N#qp7; ڜ~toU^v_T\%;'Qv_-ԗ>j)aU 뺡f*=X{+e2q X2l!G2>ҸHkXPZ!%<[_ۭ[b v>B_?`ޅZm ]9Kb}|*QïN;{;u9q;=ʆCF|^!k3q(ܼvI ^U,bEr]ZqWkWJMMiQoR]r+8s;$o`wh=QGWE%Osa5uZ#~^%~Ӿ\ 7%|NnwomOѪ4 cԩ`$^m1UP mYmA\|B0\_}3ҟ/VxDrܷbr? _$!3:Nx?udN_MxC'L(FRʋ#uXY"GGџK ;\F3Ա__bMe/O7,D]z v+ sWP=ٍstF乽@UynO$fWD6bz'NˊհRzD",x^N+!%2sm^}B08cϲg 7j(Gdr^[Ieu;O\, # Ua+2kdV"z9K~7tz,IizG{f[g!]4/FWn+>Untjmۺ߾+DT'^9mߏ:I"UVB9O3c. 6jG%_K>X[PY$n3pFsS\oÌ}*jVOmlܹ'dN]1:k\B>GiTtcѢ\.+(s|zDLF 'u&ɇ.@9b5Ep{i-KtStRIEJ*s늣[|O뒿 Sr~!2CiA'g: 0I=yM#s͎m;897sJmw O*NEA/㨡1ri_vϚY/U Aۧ}2Z#v-)#q}u?ѧ|A'8/2 4B5$C,M9~,#N#ouSn},Pǂ>nD?-=" sc6Ut5wͩI&94#Z? \^ghqyhr5R#2 gv:X/o8GC >61B.:wFxr sȟ{åCөi{ j7wMા<(+>%#b8 yi-bȏû_.r~3o9v ?1̿"磌~AGgc1 \K3. ~EZlz=#7?~17> ,s;} \G('\wg =woWn\h:EogQfy6*vxQҡnħ%w@|rz]_Ĥ1<6h.܄0jyү[ vq*k eLzELb}J}BZ5-kUe.0oEru(h8H+ț Ǽ\u_R0q;͉*y$ߟ he'; :):v(E.A +ȏ "Vyd{Xa ,ްߙݳ&wu7W|#E:yn*ԏg2UOHܝ*$8|_ D]<;=uG2)=9ԣ,c狾t์Wk Z>s#櫢 .5d:N/ԝnd=Za$Pw~сunM%k@~u>.Mox+*3;Yďb:ygRu5 8%W]uXb0 H?T|uu$I̓>Jm ܼԪKE <<7PG|ߺx3F35CtŇ~6[rQRda}A^田ޒQݳ|TǿxI\B]ZCQeσ`Q&orK:DbiҶ?ah01 |kYʧ1䑱pK+͇=ѝUEJ~W1y9K1=dWFiQep' ^=]lo8{. bhI _ $A'Vo*"9kU"c0~I ~eaⅶ-~/z,`c\gB]@>ZO~Ω~(}8vXg6Ƣn06B_Y{H'{?^Eb^k k!Rw|asm<3 %q3:f<.4'l.xj8x_38%X?H^Qzw!o:>Oc:N,J1G_7re|I /G\)2s^ͶkQ^t{A׸-%׬>&^~ ^eBI<Ḻ37y(~KÊ%),1πߌ# >/Za4S O]T S9z2bI-A][|Q#~܊'ݧWGXNڡ |ƛ_Y%EĶtUI$@QA+=<-|#age!GRk0+1\gͤޖ{i5?zNGNۺ\x$LMoB%g+Z:0zF}qO+ѹqnT;#YI>ÞtsDڕ3~:.|` T =2OQ?kied!73X\#z|s P`FYrrȾ[ea0{ZW)BGS{w,"l~ =w$BɲO >9}2C}sNQȅ)O{c ?ע'{^3f/?'li߅|OTq)X%W}yjj||.\:ܛ2QN=nO|/xAXgt>'ydG{ڼ#7IЍbG-m fO_w/vދ- oS<0L` *9{8PmG_:wF0T< rbM~M~]%%.ez*WBqk?#cC4i3]^n."t-K Oot=!;eгG`8+t+O~b!^ tm+9TsMCc,#>!Ϗ:WBKihGȯOY`CuW/|V$N7. BNJNꎲY?Gz9.mnO_¸1:Έgh́ܦ XoFsAV. p`?<)MF6 e޿ :B#)>ꦮ|1i^$r߽Y1\ߓ IxTսn2]L nν{7d@ߥ+ٲk!y8.7a9ֽ{-ڣGp,}׏kM>;=mۜC.&cJMAK-|\RB]f|.Ist}{.E=}OQ=nGRv6/ZulCޠ&<`G|7d I&7C̨ 7GVR9T`11 i+)K8ˀ}uO_lun _@. ڳnY<=#MBǔz<7>$t{Qlքx *G_ێ^zōu=uС2‘·1_(_4tC _2² Vq; ?8TF=J|~ r|: ;4a=!,綑 䡵$ h3!e >=Z؀ +aOS3d?";aYA.ap`O%Gro'O ``#]o6e 4"OK/ouRڢ>sNs7(3UT#@EV¼hԝ3*]Kr6Iva?Roi',I}i{%SYc`gjO ,)Pus/s+gjߚo}0n@*|iqAN(I~_3w9ƫG{N޳qu=MYtL~%AzO{P{÷ !Ͻ1h#DY˷yOvA ,9,6p;"|2rߚq_:=Ӈ0NT\곿R[䩆T.y̸}snKd<<^:=tZl  `{ bJv&QcEX/^rם"0ndV^~Fu٬Ǐr )yrY,x{,Q,]'[ҹ{ *if@{u._kȥ y𺃷T[}V{9t_vGmi/ -J+/69 n|ɕָ WzAϮ@>琕~E}V`{ h+ +2O力ȺbY[/eH~7#O\w@( Ng_ "Wj:_ڕy}Ze _S} y{|m=bO{,tn*!hM]O%ZkCI^J]{oV}miɭS 1+>?3:9H]l,# cik|Ll犯97WNҷM=[s}xp0@Hx-yϹ *'(| QlCyE_6~RCz9E%'x55=؉~8R8Lz d|1/(B[YeݓMs{O5/q򹰬M`;3'`t%.%cё^DGuSCQҒP*ТcGfJf{c=gJ(ѠAP~"H|9<~ĞzU-$WZw.9&Αbk6fG_k N!V oG{m89ݨdyP"EW!?HOJ)okHޝ k*eae7>2N9,m~zAxNY|[o_dt(VI?N^9ѫ=A._6gOsEoSsu#IֻɤNUM#WP6ve g#4Ecw|72ǟy]{B-HJ_lk!ܭmYy>[;MGāh/ e;wjuB꠆$G x{DK'N?Gj;![U0"^qyS5SKex++ZYx¯Y4YW]mYB/UiQ֮?<_&VNipU}!6~ zIlz!y)3t}dcIO#ka݉G6Aρ{=/ҾYgO!o+N8 ;4R9m _P70"}Z+-).namROSbB/ Y/ixgFeܗnK<5LфKzvR76 X'qM7A'qwړS]ySf,#zKO^quRcf!Oik3$o;W*~ul-{x$:zk9y|ѻUIJ/Y:z]M2QxP ߬XGgc=bj *74:MHU)ZXk)rL[ߚ?&( ؀G\2+iѰo~C9μ=υ!%RfЃu-ȣ<֏IG/adc/nkNi AJ.+vn%~ ۟yYq~NtFUU=ԘX=}3Mm|rxk Kޝ^OQ5Kc 8 ]|8{}urMnoFӬdRjVD{\nda?w5৖w#~Dme$\@{ۨ=D?B="o_x4i :̠>4RL; ~̂T\4۞K=Y sEﻰ73q'l8[Ie,FŸ}? &LqmsV.U}xe|"wi[U9§v ĩ38~U:w]Ĕ<{XH.]t8LΆ>bZM!^7?cVX>"5Zlu/O7̫*e޿ӟj`{XȺt[HSiuqi5Rw&7gyiB/lal/cgJ;?h.Cs h5^NѨIs)TI??TO}@R5n~v}IgП䠒8Y10 >w㰤W6\PFv~FqWW,TpFBi5=QI\;d->{J(5CgpE?r?]U~wOT7KF<-y7gPZP1?bwɍ~#1aǼ&^S~vРWuYF|o8CyU3Yb|z"{uK4 T:4?OTZ&v?DRwe2_ f9{2,|ɼɐh<<1t3ۃLȻ#s<ko}U!^i"kЮ_lџO$Y<$ja?'[>`7}w+hwƍy!Y c`.U~e!~'_H=B?~t0Y.-znD>㡠{~2M~qo@]uJji<!?KVS &\w̫^ٍc>;|kJ'YU?#,rF Ȫ̼Gsdؕ. P<'qrS*u;ze!xcʸoN`y5P${ц%O҅$ ~wdqD)ǼyorN[W !w:ɝǐS/%yN >T[p/ul ^B< ߠΩ>yB|p4wiiz4rxǀC|_C W9Ie)`GnC6xO wY/'HZrMRj/Lf\sVlTEsJM]|]#mdi9&v* 2M:;3z78x*iR7Yo`Nq_7k[oW_?32G ȿ޺SbgD!j)zwM9}n3Y;/h?omV',2S#Ւ%>b#6bΰu:}5[}u4z̛wI .OҶH-;\psxӀ)+b NO" z?V *pL6{8.>=\~v#0vzObUy)c_bZetK=q|ٿ4Y7q&q;//aA+;1}?Z56Y˃,Oi| o>eW8,E5ep4-Y;h7|VB;$q㍟~<|1Vcg3cv8"u~^s"E^=gP|].e{fI=|jiyc;⌵h>c/GOikG:wIʻv'qxثU2{-//<6.1 6[T_h;~9k#/)[4-nsL6w?lM?Sf49ѽ( XSo֣vi7gik vqOYrhg{DYc m1m% cx_C`EۅhQY2NX%6^Ej>pz|4~dќtpņ.[JTu2Y/Zy$@ C47N^I V'u)Yb;`_&u-'t$_]YU#x6藁b'\ܐI].GO!lR ~-?9zH >|yŞC6$ӹHkFC/j?xsO=,4#ﮉ`bG~PtG+ə>I3]d}r N z4Bc3CT0xQV$fwj+w21;0<a9lkA'[4҉}pLCO;FNC.{@uo=toA HVeO!;%Yfx8S[͟CuaAߖO"nz܇x\m[X|{{ ?AˁZ|b,y8'= wi8쮠G0|TɬV𲝼ߚk4uY 9C](2-ɰӟG~~hK /y>}vwpFM~l<# ^{K x, fĢʋE=o3D-&~}<Ċ[u>/u߫T9/-qJk{Z>ޏ͛uث97sQ?2V𕈯 GiL;J6؉sU/9̒ ˕cSUMWSg&r׺Lbl)/{9m֝~u='zAK\xjV;9܎NCmC~-ǚ:Yon?w,}4%q+3~VF-|)/w.v^IoD#^?kvbU=N\g~YdqYW/Omc|2R2SuyzayT0]]FL[v/ :Vj<琖ЗΌCjjϊEtos~<~CYA2B^sX\D>?@ϷaQ }6 )NY|&2cvB\3lWDܠ{<"fGtm * B\թ=FSm9G)ծ'u/Mmc1ІgB?:`6"?x\}ANsvLӘ"ILO75u4m"K$\v]G>z>8{aSZu`w+o+^wy^Rrd\#R</ѸCK=@ζ6|NNm 98xt*z < vr;p;ޓnBx}$uku߲>Y: iiApqS Y6A"eKϰScbd\e6 xˑ#4V>8z|(D8@^{Us_٠|Ezxn/os<ɕ $4!B/Q޾\!ax;ӟmރmyRoDo"ES'T]>ߑ&=l}_6kEξ$T_ZS÷9 t`qfW1ڣ\ayԡ;ce#Q3Prɋ>$G?qk6NF>[ `H{$xr֝qv_\y&v>:!E3hOWO0CY/n "NH~s;38~ ) ;k]V 'sYV 6N*ߴ:6vi2Cm4q^\%hV.LxqJę(?My\3x?=OT0ǖC&-8f|&DMː_m*Y.A?R9ZלGjutǟW6.}?O~[nߵZ,;;~ hr6<]Q+$Zi1ow Y}9)y)FhW6˦.1vN!ZυX!FAȯ?= GҦDITN[Fóu7o:1qc+װ"9`PS ~+L}[+Ό>q |CMd~=vP6HsSh5S3 *#TKe*Tai }Sm_# ~:S[KnD3Oix:l@c#˶~sf#\f?uM)FVraR'(nfu?-7xJX{]ϻoo]´5p2VLXP$}zPW2EKwLTB_o1S.qjKMС=}|?T$o*D%=zAߚ sMve[ɺPkze7K_J߳d_5Wa*q_){3# ra/ne?7dR6\^A2{ |#kn}|0ګ3*Kwrq!\X/q!,<7.`9\}B%dN{eN2_!YϏEA|~O{C0~1ѹ|cO`)>m_ɲr@/uHXK|&Y_}y.}ZwWWܣ#Ç oj & ,:~%u\k??X W<ȹd(dXw?9VL퐟4<$acX;aVD xEY:fc'l{Y/,q _=.~H~}$9ρs/'_}W7|;i /o$?82n Ԫ ɯ&i7F.TV$uK e'vVWJG^0LC^66'>hnaQI?n`QNJ\JE7%r~sHl[|}az)Yxn@Ӥpl'<°hJyWO;A y{*?PB18tN}?~7y|7u#:D͓q7Ə(!׈{{h݂WH9 H}YDޓ{)gMMqo^M(Esd㵯,@_4MB{okL!Ad|(ġ~wvOˏI{p:/]d> la x"-T?m#bߛ/A=;HQ"ҋ'  yF(cLԣO :;2_<zHONYySl:"mޏxAldhyNM=o}T\&4Bډ#s'W'DJ۩: 'id\25AnGvבz#G*ȼCoi;Oh7|beO^meTu/&mأ[ƧS=knˠk) tϽza׬' a\>~AwN9\xӳq/3[]~) ̷^pg! ~~F]?c ox]4Xl9gYK>Zψ˟x8OdAmgh]Ĝ-:ȷɟX~VgYYG N@)a"Hݡ?7=z: ׈-OHȝm/抾>wU4e3 ?1Gxf2_ɗ^;JD{o T=Tu:x#gVΒ:M%%O4h7c˯&4-ROxg\1xGiIpv3Nwaz\ Z;ľ-% Hf:R`/_REԇ,qr~e=y2{ ߏ8D~Z:aKG;wvc:7;q<"["9^~*;059DZ!./$|,?GH[R |:8a)7XT*M]vA~N>f-=iDޒTryu/`G%FQv&[gp ȡ伞h@5^%v9UI_ ֤O4|Iv[k"x%ˈO+]|ϼ U]>@'ub'BNp}sUBHf[]NB/.|>|>#xqxJUZ L1_&~3޸i+mNsu;y6PP?2X/o֑;r6 ֛fSѮ4kd]~K7#;wYW|);(_B/x\YϾ}G3)paRשo+!7zSU!VطS٭ߙҨK94z gAs1:x_{My2opxqPJwfn5c_xqb4"P?ςu z"^ ~tz0F9{4n 9|/񓵰kE<2uଢ଼mJ.rUl!&~PlOǕԫ#>[8CѨ'Kg/}S#xODMuvJɼdKT@fy>wUR(n!̑PWxLK7<3o)>zECb乐we~qۜb'k'Ysʿ%_|M^U\C2gkܾCFī6A>_ W]7E$:5w%DmȪe h+C^`'bYoL߃e뇟I7oo?q:[!1t.~qr ! zvo-Y> J,z@}#/W\J2WQîJ4jV˂ȕV*Z9qF:p 1^8Lٟd?SJ1}zsޛ717 Mo[;vFMs LPlhow9 ߌ.''7)?oIޤQNU،s7lPk&'z㻿!*ݿsvt\%'iR+_7w%3v_3_}׭VU!R( UXI)> yG&wwؐyDDh Rwh!VϺwNimRtK);ǒoIGo3(=a=8HꜝqR f|xAӟZ{ٸyy-p\oR4 =@ց5iZP{n[9JS763nQ|CNRd>]֘uKc Ywt!2oATEÆ͐eBJk.Mdϝ}DK͞)g9Bٯ4{.d0?uVNKo=rj%xr{dȟG|')tm d<+^}!xǻO>Vlr>|ҼpS!CeOyH =Sc߼Ik@^4y$T~rAJ>VS&&r Q?o/Mzz5_NGrl{]٫9 jli-62ZW vaIj:Ks/](A?AbUL75l| ['#=!-ő*5#=<":pH?l ~)h~ Y~qmS2A+[CQu/?AEWq\FE]w۵[֌sV+C/R]g~)^o]z3u<ל+T:Y>"d9= t0cd^?x-d&όV*Q.E{`{+SpQ9y'6V})xO1s15RXА. ?6 \&q`6E}+8*??cOSo ^7<3g9WDV\Wv"if@xD3cJ ZpFRe|5'W3z>,G-)*6ߩ㜰*_gu\fɺd~gGe}[~4EN6eECf/l&Ƃd9zxa#Rp |y/tbpVvP 7b?Ŀt =I^K=I4}Qd=sj+%6糆,.{ＺđW&|5PE뜼:Q yKP$,:GK"*+ĐzLa3C*b&+ ^7J_6W RG>@?G$IS1F)˳\ ^y y+G~El,NZ~dG~w / ~0_ҁ?g*1< xy}UN_ ߈|hg}*-d]#>kvGhC3E 8чH̥tIu$m~*n=s Y7Ju&-elV{BYYv~}Ec ПU'za?i.wC^Z(w!O)2B-^+I:h\I\? ;&Nkk(F _63CWh_e8Pg|ܽ%Gp .V ?x{ ~Ȁ>gV"ɝ"6CNU`*8 pRN3HFwd?jyxpG|PۅGz7>wZj26vԇMaϙB]L_ f^1+1uA/Tϼ%u瘘o>gKð7/; '8(^'7IJBC;^ϴs-!Ggh V_[4=\S.)= 4<48MqGww]<#sQ_vW}"G&2bF=~\:^ VʤU)QT~"}Dg*_&Gi _+oc} oEvQ}w&!q0,ʑ_qH}ȋU9lbm|?~Y)}TuL/J]~z𾨀O1qC~nDD3'cwV ̈|K~2jy}/?2bRrI< m?K9.|ͮvx0wI"m!uCTgG]X0|fo~ix,>t枇? d_rrŻڰ]EWa7y:l1ԙaG<|yAV`68ʯ݅?=9R"k,qvl}B۱ _[GE'/gwCNG}g;ï Š}닦ņ$x}s|賁ߏ SUH]>/1Wf] LpNp;Ӟeϡk$ٽ9\пsΩW.?gMG43ī7ߔd*Yyj֗ZA[A=` |uЃN H]3edILomJQssR4 ɞ(%toWz'?EW}T#Y9y@~`P|``aZ ?<"T:+")w7%g)-wYŠK֥gϸU5M,'ė\_H{z蟭YyŰmzݵ)mFE;9׵Mvn?DFol#u>lNN"F2axp8~ ;Vf. 6}=us|7wRmirLH?@[1S"O;9إS pʠ iYJ=<'|J{l2ōx^֞C?H?}~Re۱vqUEud|QrZ@G2wx%4UЃ^se$+S|ME.%Cȣh}.xnȋW~CA;ځqg#N5K$mJ2"x'G kJ< Њt>o.+Vblĉi_g*YWnΣajyW՘*ïdy#?=MлLӔV7Yg`rju2Yzׂ͆9أ;evhOfr/9-FI| O0Apd]{xcUeĭux^Wl =[ giNѫYi݂nGT\\OQO!kуc<QOxF/& mmFӹeuiT#+"g5bvZpFBe;p4dxZ$1 Swepƍ6ܤNƧH wYF/F_7YD^׏BK8T|mfoKoE*BUH>?|%Ë">9|ЙQԗeO~!PM¸"072$Kp_ 5|쳜"w_xc)w|AJr!\שw/ 5pC򹸚aSF擕J`ewѾ.iWhߞ'/|Z ʾ[H9>'ˏ>uֆs~ ڤu*GzhѲR'P-ȆJy{ԇsJU5!|ފ(t{ΣA{Wv>?U;Wk'Tn¾/["~<ȹGg9-cІCQHdfq-We Yo~ })H8,M

蠤[8ma{A~pϻU ^p!OHJn\? 70*NR^A'7mzϳנ?a*7Y/%fIuFa=`:(ԭ _5,9𕄄lyĵpԯS?ɸg]Ӟ%Rџ[ {0xpW % cւ>u+ 8V}4 "uAmboe VxHh1m:xJ@ڜoGʿa;<6A6cNc/RvzJfr6іӰ{̞M!7q] ޗ8yA?j;ث}S#Twddu쏔uzRhW>}Ò?Jɲ[`'R o[1j"2X3|~ x~ޚ .yKԥ/f_](m(wI}/F_3.6|0>ˊ 4]ػzS{u_ޘcȳ4tνSzӱH'= #"lcYp0 ZΊVߛJY2 ˍZLJwJHDQ#J'3s;OhhWz߼~ټ܎8ە(:r5M蓆=$Vhf ;_+@0fI:m X&u>W3wj_g6~)u\|uB} 7xHߟk!Yq]2b CO<ߣ˳üU lKY!{\(V<|GͳGܼ"8/[~z s+Um9GYR2fh_2J9#VYRRsiwrg9 7O+ --Y!5d9o MӤAgv|1vN.Mv{v=# r"0-#|;G}ě#?Y ]I% UnRa;W}{i+R6?tW*;g:<-7yĢeTkga7Y}{-[dYG#~9VtG?V셞ɓlJͳUyd;˜0LDe ]Kޞdު Wu?x[#ZDzQ:d|T4ӍyW1:s7dFQWUIHQ*EJԩM{ާ{飈 % Hɪ~9/<}_}F|~3yyI>S?ÈY[OwR ˵ee9NޣL[5ԄKׂ(4f댫1^ډC΅_Kٕ$Rɹs+n;4ի Ǟ|q!¡u׬j-9[ak5K{2Ƶ2a>6"#+2P{A~$OU~@$mٔv} {/7}Y҇-,\2?jܗh)9fX3|_ s_պz|kQ ~5:c%R-1?@ꇰ 흫!ǒt_`4ǻ[N*v4ez|?Gx.ǹTۆaNP~3Ug<+H65?VL$␕{rģtwh U<{\oJ˜AWKi{硏LU_.-//|;G2t73URqACD^>"e2ƷjC &u]_F'FL߽e_Mr.>o 1 z 1Kg!WQ.Ki놞wn fs κV!}P+)8[/=Q\WX:A/!#K¤N>̍_,0* xj/潤ҿ~p>S#w?`&Ms:%x_ܤ 6~J7C.\w}Y没} ||Ă#fsf_η+w|0:my/y??v]u&Rt\Y>UȾK>,ǀ1Rvs5qs\dG N~em> =G{ oɈ=z[lWw)rl(Qƚ$Rv]fOTx?k(ty)CI⸓[7#ۺ<~rU=EιN<7zR#umvK sLDYs|絁wب_7<}3Iu7~`q!xb?7'{dL_};bKJ{ *O;o$T\Եy`~gV ڽs&8V+1~(|Pz,SO۴ў(~|j}ly-ak3=ܵq6^S*øoL+;nOkT@Ύ\ vlOsߔk_<|uNk8%Nsp&޽7(]Q## <ǽ<,b "igo>AӪ ՀeLzvO.jC>3H5 \>.xc[-1w[uD _3|dNxW"m؋fkKQh^ J OS0&~'Ka^iKwrb^^8 =(>KO/^y+8p1#=[d OyϫٮW oGv{ywNB~#y/be-9$y&#~J/$XBꄾ,Lܖz=~ C>_>Cx3c+0c_ S9'K}6+k;$:w{p}PL-9Gvdsr]L C#y)vngR9ae o0^Iz>&id9(Uhb^F5džI]3(=nr8$"7Oz4;tz!7w۪[O==tbiG/C_ra'>mH?Qϲg ԁ=j sz ѕGՉRXGp_[a=㽌OHxE)y/=ۀ`yGp2=%=̆#{)GvcA1˚/iOa^qXG@msckL&).oKװos _5Uz8mݤIZk.aWZdn5pV`+Qw iRC ڲ]j|Ϊ$x_4AܴaM/$r_}Lr'RO__{S7&R)y`~ZW_s#%J-p?W~JƜN'=oc?W{m&I[Ndn_ w0 JzD Un[gSbmSσF)r_NA^'_yfWsyorK{Ax&a?YmCۼLg IP.({%|8zr0v0ZXDayӊ8HXv/ϝx}M Ti}&=%Sa+y~#(F򐚟,d_r>zU{= O~ S}/b=o$-3 d~T] Em 깺[Y3GAf = SOm]9,ߘ7wa~1Oj"1҆m_#ω'xuUrA%nHa YAG&Rh7cm`< ~#M6r"8{=ߖP!וI1$O}+v~XUqpЧ͟K2/-jQG:.ß7>\OJrЭֹ݇=|\"u')'"B RK[&̈́Wnk \6R܃'BrRbZ3ԇuNN&Y9R8QFQ-~[\a-y?j]>wy4фB:HnT#96yq"LK.Q9>#Q5!5$k0?騮 P&O+HC~1c5u|qbĉ{ML[QoʘϘh@~;'kjYOncrO[ ;?r1ԯoV^8bF{\ ty9swO? ;e;[Z|/!kab0VfQߤ_^ou yJ 9"-rjp.Z T>mj߁3vjU?Ig]E+f+pl~x~8iEί-g֓~Kh?|z_4)s,>Hc..hє0NnvyAF*?ni;~IB4O3 ;140o [Me/:K'{g BCjw Vea |Rjyt :v P?4ݨ܄V&>D~t?}ŌW~<,Snr,p5as%G~Y˙CTy:Ux= =Y\i`7E]udbA%Woz$sxplx\B7>Mޛ68˛+[l̀D^ٹ|*7څ|ZXcRPo Z쿳!WT=NmL]=Ŭ}r~C@GUmx}aMS {NUarI&Ƀ|y\2{kk:i*dfNꍉ]] f9"M JFev/D\s[l;@L]u}QVxayggVG\X ϴ4K]}FZn\q|Ά?c_kٯN+&xls8 q,skХ5}ˤzOu6Wgh!5хfXQԙMWm̤Lk;8?kU crtwbooN~,^@|zZ ~[`a˙7?-gOqZ<&Ihcz7a%7bޮ'7\6's^\:m$G۰=m-XGo ",.=-̓&dsz.%^ỳBfFs9;+_?yVG^7 \YȻbx3 "{` .C^a(>tD呯%͹mbdսҍnqv~о Q_xbr`ȸ zbUa 9wP'aM s5sƼH eo6{Kh&m@ΦGv6I` <ڍS$H= kwyz %?1Wb?q WG_c!i$.SVIΓv.g ngk-FN-t0/^LΓI ](kU34j7YAZ ټ%9E+ m?;$-?+k[lCZFp&?άĂQe9PԟtSCr#n˯LsE%Czi%"DEpH|FmI_VV}EÓLH}6d_E)q#1/rw>RZt]xK>:߶lfް,F )NQ/v#&SH sH +۵'OM@܏>/ {e#OzjnOq~?&%9w6t_Z+mùOn IԹ?5x!Gc#ص{Х`UJӽ!170G;ƙ@]A'8>vC^`v-첍jJ|?ϯ%\~m5Fպ/PSjðKUH/#=R Wȣ)zlZt6M l߻CFl}9|->΋MXoӞʏp_q=h%={U/]GhTW7PW-4ÅMoJ}{9Pe` y,5 |Sm1E[ѫM!{hԬXJS$^鸺IlenQwwۆ,zѣ+R }IC:1H(༚FߙCK>M)IK+cSۤy3_׭? A^S%j,G o|aw){ p]x1zؑEt?_wĨ ԕE6_s~szϾloeۆ$蝶R uw\aA ?'< o[L779"B\`}Ru: l>1SO6%Inn#y,OsQ>QުGxSU>#947}֕(88V yQܐ"9ƭ[}\t[X5WxA$x\W=WW35[w{A-ׁ?yYb4Ǫive^Н?ߤ·^u]eǼ⿶8\x?K u<'*i^W6> (eV)r݁ȧ29u He]h6I,y~=0 9;:jq6`4pZЪ{?+| XdNocR$Kd_7'KE 'Gzْ/ȣ?/X3W`u/ P&n K8]|Tᱼ Su`ǗjR!gS4?[𞃟.龁>jv8F-рW91^||>H:m?zMqxyk>ێϞ; `+B9̉u)rWOBb^IYeYH7'r%1G WI]ⅰ`AO2]Uw4zŖ #7Ys>Nvo3?wY6|q ھ__9z5'别T[/Bu͋O>oksl{79OUۻ z^ ||O']@[rfq>$vZpm]726K RdiV.'70bzMd/[7QVyҮUQB~!a#6t& ]jI֗;"*뱊b|# "雚.s<%`}y?Av ~|{yk1rU s8M-8ؤH0w,LyU#RvԭWХ]6)~OY"I:1c:wm_MV.S!<.]:Lj"_#r~vSEwh ֡_kXXm#u3#Lr #ȾSټ}s;g6?wwU@-tvљ-̦1?]{;?2^ 8b=MDA O~ρ؍*u*!.|Bm_H?g; I16nA ߘoԑh4^V\q>'HIGi~iE_Y*F,c4{$ӝ@#r~ ~Uk2ҠU8Zs!}oN81\ ZNGW ]N׃#[HmK,\u~/^jkz !oʆ~תtI ={4nA~ϼ| P{HFYKuȡrJu;d-|;A^d~"}9:jDh#{ƂȹGf)>x~5y[?_8ya d|TxoDmU *:e,zD8-ԭuKJ*s?["y/Tot| ~kaFD7Y MZs7V4=A\R sXӎMkw ڎw OFY9ET " ^@ߏDwAAF74nrN|tO֔<:Hέd"\[kt8 y>Ve2^ٍp/߬݁v{z }z_Ia޻ P|gGN6%Ԁ/iG;n @t^ێ?`Bm-1Y[7ro6I]~^o\-yÊX51;cD (xJ=6U#RGȑ3ZzL &S%yc~IBLvxQvC~^%Z=MԿf? mɹV^TR:ct²;,=a^sQuM6}%'?&s@%'3OKgDG[ JẌ́y=g-Wyg{6 e"oI8'BճGߒYdgcy x8xHFC']GojGl̛_MIC_w/u ioDt: ?q3>+aUf!ͨ>}//Te# .9^N"}ԪO?JS.qB^a^>ۃ 'ɝ_b>髇%aɏ= D~{5y/"a! f~w^؏uyyQ>߇?VOCl!"JV렿+awD56k*;GΖI2?3ÿCeu+oka='ܟI5٥s#/)tι? Q9ą`kYkx6RQ9#9O'z*jLFRu'+ض*R><"eF1֘w买K[kW} y:Cdrg`H *Ճ< ^Z}:YH} eѤ?P+<1Xʡ.7A) _g]s$wi}NRg,Z?R{GqOUbZTv|MW.~$w2g׭FV~_weՌA喈mo~P;- sep~uxsTG7oQ<s\Hr'I˫Hl~Huɚ"|+MAI3zAY/UG~Wz>J*yp^x?5rbi։N2-QγyXW>oތMxLd(飚VXLsT{+{S=Gdƌ\ǺX^x8"|E99c7,(8Ҋ2>=>yܥ]F<~3NƨŅhoXsABw#!2SI_V(x9Mv`oѤh8$j8[l=f;=p8>V6]<)ºT7(H}eIHM9y$9ąViϣd?? &˰Ss\z?/?)G>XS_?<]|/kE޳6ҷV{þ;v?x/6MHi_yپmw;l<0/f iϚ{E侒~}d#gkeCߧ^+?$]C͈#pB3oμiޕ$!UD@ٽ*iˍOʑ*Hʰ.c7^K\~#C|'|gOquW3yD~NGsŇSvbr_ ^b ô xO/7`@x`ѡŅe&Su[ nѝS !}_R5yȎVd?ZoE!u>Lg(YC-T9ր孖`} \Jkb^-y.y~ JӼ5[ :nqh[ ultduxH*'+h'ۊ>N2"eJ1?ҫ/hDՐGn;[=H<;cNU}+W -Gu@RX&̤ǟ`g;ſsCo| |v=%#yw%3%;Z<^wɶ(GW:T?#fTW^SXeՀFz\TZ[ϞzDhHuqͶ4WܜEr^/4rw[u-#C~>뤈y:K&J?S;Mg ;#X,ӐSMk{/}}nWf7 sCfF#I:Kk O? Q?4K5Z~5X6K7JLv z<aWH0^ESG3o&פT,>*ïqlżD48vzVSI8x[O14uߕ{ǧËy}玻m~7~orxx슛kbN]D:2; kUYlDp-o4_ǨMKzM!r 8\\]<޾~v3:yݘܰ!Y2IkD{_Sk8)T,[ETɏI A!*b-ʫ{>ؓèd1<Il u2ywO`~Ov<ӄӵ?hIMZ_2 {<`O3e ĕk11Zp=]-cc ;qO,%Cu|{#0/E%xt]o ϲ$Ou-j=fyW~7^F gytrv}2.&?4ZN߻gyۨ_6]07/".VJ^Zq_հ|#hwAፏSx|vUkcg`OgjSu"o}eW}U%c%#wFl4my|<>WP]ٵeefMxe.fMٶ/wzx"ȥ@1 7dW9Ey,XAq"3c8}E,}eiŅ쓈(Qϑ39r$?wxD:L?gT z:lv v_7ڶqg 9ǣzt'][x~![Ey00 B7XLoa ?slGy}چ̤ܸur&,v\ɿ'q^4&q7Z5^qhAjq9y}-cž+R#֙=5U*),&^W;t؃IQ9vsl%ڴ&ޒ>1.Єhj=~?9_V a~VY{25=XȄ? (C^`ϟrZ ~zVYL~f{ZMd~JΛmhWdOj#flU4ï<#CisKċ!/!HfȳZYG yFĸ&[m{u ^0jCއqlY%s?DuJ%k쟓#rrxbyy7Ӭ j#kΫ}77UpC/gM;/ x_8TwO8Gÿ? xl^Ͼ{i3lKyCWwf ZZ6k%>fxņH|r0X}z_r0\ "WeaM>Ō?WZva]+žmĊu6pBA**&Į/26P㔕4&=v>< op/&(jv}%uLD\ &&Rcτ (A{]d/~wd.ăS}uջlF9(5+vBߍfź̿LA6;A1yTlUtfavkz P/ϸ_9!|I㜍:'L5"8+I| Iת6W&yۓ4;Gdέa}Z&l`_b}*lwY{8/ 2^ y= DvƮ.\}1~V<0I)R6'Nu?'LP)6.ŕ}ص3'˸}1S#ߝ;|? 9- {xRO'u5?VvjZ1ܔkNv?j<,s{jN|PtH$Wu>W~X{`.[amTG0/ 2IrO>8xUrq/^M/y/;#d>81~G{9Teph)y;2s 1oۅ;7W%ϯyUzng`mcEȾo?BWX:cO5gKoaoVRd>8Bj_=Wאs&?{"WTb>>L4ߋ}FA:?cOT??tPv?չ{<- _t;>9PD 58K3v:^"tDߦhIvd;c"π[S6b\!XkN<ثT~d@/HUTYp5wt9XǂyD0}Oo+$jr"} ̙G:Q'K;/<\E$9X '8Z]%rtG~mozs=UyӉΜEJQڭOT(S>tzw=ȓ;'KVL Œzs"/->U}7( C> 5OѢo:bxNjn꠆'K7(Gϕ"[.d<T`=X%.:2u"RvגO!d~fĩAƫL x?~as|<`ki'qR a٦9#T"fH"> <=(t2h+S[mj6a|-~_0O־kH}<9y6ŗ) Wٱnx_l2 yjՖ̓¾;$p}G+%w@4x^ a:{SI.?hrsI\d$&cnG#$!'31O /UUQ70>-E u! >/OSmI=K8CR'Ơi|?ܴA__Yx$#~mA# _+ *3g3_s\aIb\z43ײh,ٷҺwG{ d#Xy :. W&6|O 8}@b/9Y<5ljGW O:dD2$:@!ig K;q![.BΧwoCyj*LoXI}Dgosq<8V+vP ^C 9F]2;f+|d(%$N;FIz)C!μVZd"潽MLlLY@o00xp32-ܴHx"nx;}qLf WvAOăB|Ժvّm xS.R~{ZǙl3Ձuٵ6:0!~>1®NV :gl:@VUhQc@>u١v'I5g<ȈGYكuřg&5z.0 {%8&$۫Hoy^akL@ 2v9Mdƿ<jf^ܛarŴwX \maƛ{Y;y %1Ib 㞰Kݷa~:&- d?_#ͶckU f/AFVCﴉՈ[6V}إ IH|{ߤnL!s4z^w VJkط5ð>U"|ozm\g7@2Ť 9"`<9M_Z}PIyTckCp?  GZ5؁)bO.g pƲ)MLx!xI[:q-֛wʟB=22{3:] M> J|sj"o1>>q>@jg1xo%nJ8&d(8Q6[!xi e߈"o >XvniDӚ)Ru)ljެJss/˟_Eo8ۄ~5X{8ptc:m~]V-{6.%E@&ǓRt)}eRSq_HfOdrcæ =cgׂDm/O̺a8Ot8Rr$};<#ͯ1f}ˣ|m<5 7>sg9{)mT)xA|T?dU;x\Qq}ꦚQ9R'{z~瘤E'ٯGJ ~j ;,Lp MXB쏹c} ;oX38r#_ G5Q`kd?ޔty[V#hZC9!!M fTt"]~nW SvP[$ywN\uq hnr/=cmb\>HuwW ,' ;(i)/9cO/?>^j۶o-wN s~zjgX_g{yB!uq61{N2R_xtF_nV{tg[)%oMSx= <26\|cWS 󇞤|Q/\盶r;x;} y"9B[}z4]M4|M{8Z4ۑ~F*O"lv ^G&紏>w(%z[y 66ۘD9o拐sȁ4>E[^}^7j\e06qUvr#72ERgaw2+BO MbqkzJ| z:0QAiEiUՂ/>m :GI=3l}]: aQO v|M BAXRrYFE0@`QQ D>s̼Ήs/S9Z; %k_K?fJ0<%W$D8 18pJW٘ok? .wz%fw0H{P|ݼG>m-(oF㡗;?9G|֜,wa"|OžsG 9e}Byɲ.r_]GvEQW=/8_\O 64^TҿU|0jݍۈхh_8C(uRcYWq6k fqEHarWr}^ 3=1y_^:O)GG6dLwu'3|[ BOt|{YN5u%+ Ÿ( |^|g3?*ﻎC%/j*]wx.<%]Tu8܍St=bزr -ҕJuZ홋1 4FJE3Bo)uCt4(rns;M: yȦ ^Uҫ]6?)\҉<"mwO-ԙE7><]\|Q-dzכ+s]77q17f˘o#|-1꒔uPgb |9VBٟtß30Τ{n+G1Y^_j'RVa^5W[]xI6S_ [JZ{}o}::ZVJ֘оS1ݫ,?c>xo88ޙ9F/\D{ҟu{^[^s٧?b]PGzohz\Հ[_Bod=T %єI>=->]C_;at~ExE#u2.vx 1i<60!Y4vMzU Txb3i"oq&[Yh}d>xUMltB|}DxpO.Ї$g _6 7ڠ X6{}u`iWd|7 Y|mڰ$x'@83ȟcwgEfÞۯmK~RES51sfW1yf\?Oqɮu{ҚwMg0zh\{)&{B}N<xj`ՠ u_ 2J&<^y9/lJ⚩{龨^׃)9o_CiWG~#+QU//ęIg>tΠ{35O12o_x$ߡ ,>}/W@@|_$=`yLŹpyxm-: 쎄~Oõ8~ y^wW@'q%C]gi%B?]7T@S*ޭ =v~D(⃴-Y>̰1t3imgSDYݩ-KVc^B妲|oU D;^yh`y  z7(I}ZҠ;D@/ h?uf} 3epunLy|q* _OpmI{$<ʊ?*sKFNnر"9? | *qW`H`Unô7d7Dݖ_UO6s%{WyKGrL[aURa/kF=n8g/vjAu~C-{ s1OIL~v4Fal{a~x3=-|D߿XMl: πp^Oݵ- r$d9khp +^`8Z4=88F'a{*'Y';[Eͯ-\k41laf/_I͊7!2קMETg 3OqM6M 𗈽'oob9ܬ 1?i5/$OEݳtYί{-b|uT|{<r#,/Ӕ' \?qRZ|:+,wҲag/L ^CUiה}N֘wWkI!.Zarhv2uUΪ7k) L_{`>w[Y|aZO=ĻQfE;gv^߄z =O /s)6}٩i$F 7yg L.YL`] OèJ$ݯ6JT}h}T |T~ViqL 8Yի۫홝H*#W>E7#i<5v}S:Oų6SsE@_BWQȯiL3~>>(4% {(LXoLGezKxfw uhBZA>Pti>uo;Uvz|<ކ3 "l[%s1zwUoď6r[_eeGz0\*, )WX۩z6xuw[ok2/1ֳ\ۗ BKp2j +rm{[,J4{-疾ׁܺ+"goRlKk-D"n͢tnGwV?r* MYd"_;O_3 YM//gޖ^_$ǟ;_ٛ-uD{ e?'\gMe cVSgy`sKZ4oz[Hy;wo SZ£Jĩ{클,Cn|qd+"U_  vQeޜgmqe|rm5h7 GP |:\{ϛux$I҅ӷ'f}4`4;ٛ4?oZWyf-7O}P*=z/x{ `6!Wc@q;BƳڏ3p9*WjJ*ZE깆M fw Pao7}Wo WlK! к!=S0n;T? ᙘTQxg%t:½7#sr&3ڎЧw[NIύd~tQQ 7_^i̧C@GĒN&uv_1Frd`[J8OEsW:.0ܸĂªtk~K';.ௐuE%TdFuυv.p'Ơxk%-Rˢ)?8ݾ2Z68|zWYyY} EG sCmJ:/X=`n ,ji_5:nO۴ݹgאKY .Lϡ|ܰ1;GC/Tզ>9Oqp]ugl!&is# |&߮b9g^K˘zJ '*vtv7ќg" /ZҳB^ډ&ʋkv:?.Ջօc .GF_Y|;G,1/bi;<3ۚ鼾& 2uǫK_o-lB<՗dbwX7F6I _~M9z#Ssw{aU/n{L'/KK>f8(2>w=!d s럞m~yz2-A+F^9yD^ ߱%sgZ0e ^r9̹6c;AU0Yir H̆e\Tx]8=Iu>w5/98BU݃,BM_z݇?ߡ0g],q +dvݴҎiwS{N.[u/[zQ <.2v\L|? <:, ZAC輍\I/ vn-p*J^W,x]\~wpO} e)RaIytd a섣7*e_~xP/ ݎEoL\᷒ ._Rwc9[!ڎh'p^SUѳN˓Ay_3輁Ό><=zF~kWnmb !~a_7]Zxx`Z/;u[3u//rҽ kh1M2,}m xg¹ {w_;0FAєW-؂ G騋1JcM'xΊ:o#Bo\ iG~dh6TB_scχwQW+f9s[V{{1գ-![n״*se\؝Ok~:HRt^0DsҦ_7P 釻 p*صَƟRZ1gk=,ÙyO7|CV&||ʏqdp?-o=MvHr)˄C0?x \At݀],x+&pܭa6{B[?VO|+_O>r%{|YXaH9ǁe soyZjW3W >˦928!;=)_ކD+$ 0VH3:F岚|ԏƫt,|<^?kYi0}o/y.ƿ𞨌C15])عٰ+7wVEQ=%bY|)` ޿x k2CTWTWTՓQ"q,/ ?xtOZ':Zʡg}#z7|Hv}?w#^-Cs/(.qs0y< `w=5V²u{31;]֞Nwn9\Om'We(mXqܚt@:d@ ߺn_1M2ӯ/.χ'T0{1L OQ7xo"# <*Rr b3ʳ~/v(V?}*~nWlʳoA,hO>H>J_#X_[?_!DPQScu/y| HjG-HΗuq nq]$6G7~);ʑӀ猎uFػ&瀇D5u>Y3>Vc<~DF$Vʔz;ZD/Zi/N9 dxߌ:v]u$0*oh;-~OJdJ_Ƽs=$//E/[߸*pV<w(7\fU4Y7 n .݁53xyX58-ɎK{t W}Y[rޒ;^/ YEn;?| ռП.7*ﷸ7vk "S&| &g', {oy< qS.V7Y,Ξ&)v۳_8Sx`?k 9's1o%gw )*$gLWG?[=6Fs|cz-F#&XNFX|9g*5W?w㾼-% ]f TE#^C._cFҎՍ))5T/BAAJM_ 7@i+ $ί8;LݍTg5LwI%,4!/x!1u,vfb!w<"ߏ/2[wzY"؝wT>m7sJ-5Nzf3D&ܯϏ̈́ |%Ka+'alU;Ų`X;r~)ͩ;NX 志 & 1KR*mca'ycN KJWyKZfp*2s#o{uzw|̈́C2t>ԩnȣTIn\w9c<4Hy~ G=`own"8TO{9#N$ø};K:">Ipf߅ob8W:#3ZЊmI61uI_݈?V\:fr|0yζF!_ zג^?rbX > :-5C,kir#ar6/J 6̓tfF3FoҌYR19&XIgJcksՏo\ٟ v8riF%c0δ#c[7{/T zSjsY 7vS=cQUǩr-ϼ+/@oe~~xc*x+(m.-fqoBr @>e׽s|s^xۃ+;y%~^Xt(-|5'/S wڝ7Hu/ 7Jh$P֚Y;EB3sYtt9 ie9qrsJ\|L(oI˯Eq]-a?Ow|(:#1Kz˺N${ q3ZO|B*ay?gN=΍t&fpJiwCm[~^n@qqHډS0^ ?f*mWI-ߞta|tXOKP֧SzàoV".PvǺnq=J>BrSy,BoF5zL>RJ:vgٮ$C~Wl+<'eAoG̡#(wvOs3ʋKc7GO\+/E|`r*h+F/G B i4;K</<7i}8\)H $emm4i<$2DwK{ ㈾qE%+.+|zGʑ6Z Y`% O&޵ϙ53_O 4Y_5Y NAfX=) _3׵XA/+Ϛ&Ҿd"p)hq2Wluaͯ#v}_ 9&Gêbף<(LOw kهZ:/2[z68ްFpU?sQ?M"71(pBo'Ћ(ʫՕ\v/?^/o!w͇]ˁ/^yK~/?^F:eUo>bZ6Fݾ*r29*}ƕRѿ'WF{:Ðf-Rݤ;+ZOz\glZy6EJ献pA NT<1aJ,qqs\.=N:5heoN X:(oP#p |dk ~)olNS%Eku2^V ;=iW97ҳ?ΰ8QfQ[֠0)+/I]B^WY`ϻ߰T ,')/v j!<^Je*dȥyAONYi $-yz5P|=>[Y~4AwUǃ[bb'fqUq e}mӾe5nlk5Vk'fBUٲߎ_++ 7ֶaÞv~ʖi%~)WN&y$ܥu\1nO?CC"*,~5\Q@? CwY]xilAgDKJ>nSIy9-1/غWO|>N/<0=' ?<{,u6wH[Tڔk]o|U|EEN_=|0`+"mmvfh-m ,xS} =<_}u|+ <^$cs׎yd#r#^V { {S_nxObZ ϶A}ٲޥմ/019 |0/;{(`AC_4{NJ2?O=Eڽ)7kH`J;@R75.x A\{Ex{jLz T>+3$5O#ojOȯVh/߂CO1 c{xmy =b垞YpNrؕmD:x }GlL!臥=r/PHHU+:ǟwHEcN=ѹ&dîlUv;dw:cn 5v4x_܊-g?yLkEg H] a#mwz0Õg1q2T8+9I3rGC^~[ c ?P=u"' N`}6ίuWi<=l;fmtDiY Gmcrm9avehc#߮ EѼqmVr 3?4QuK륃e)ۚ MS#o؇5d 5s_ ډ=e;cq XHu`w<$& >ET1oУ'| h^:7+K܊-"R+ky'ϽيsgHߊ$*^tĠ)xջ.+xӞ%ztn꘿/NCҬ~ u}8gOcG@ >p V-=:QS*t4S5ߵktXH^})ƙ0kb5wOr/f::6s (*NߙYkQݺ~1EQGCĤӞ=ngHLt#rKw | 8+8,s8Wo⫺wy|RO6s#J޻iJ3o{Iy. rNȡd[P.1NRWG>;gC~濛E`V=Ѿ~բu*c1#oH衪z-ߟ?qq:ky5Tˠ| opy#BK`Ge>+|v|~q .;x'2p0c[]HykxaJ7Lw(YiCcȗ=cLaA>2 aT2⚚ ᾐx]1/epǍzWͫok-[HJ:&я\ǰ />y@óՎS !>4;zrx.(fsf(U>U/8+/]:{siPrc{ekiܬ3Ibj헤 HyE}ɍ~Kz.z?s`s%V7}JuJxZ+ovlBqix Jkj r3ü87'=j֣t's =f3\d^TN(fdc[{&≔`ZP5\N4~@\z+'%*9}< ~w./:|٪^ؓoA)ykD΀=$l)tqb?Vv٬N/} ǒ+vҾa؟Y7` 2Hִ8ZH&WS>vnTwf*keQ$z8KaxdKOh3_FylVӹj#,=kޚu![ܭ*/r|v0;ACKNmi{ y|`{0F#q1Yo7E g[Zg{͜Fij!=`?YBtNʞWi*\UiGӪg+L|o2)Y>ݝx pYnBKucw ~"Of07;=_%xSB)OP9IDzδ3VCNj!'ߧIgDl<8J--irdwMҼqpΦ'uCnt?-r31NMOsq0>;QiagB!t^G3c-ȵ_V03v Ö^n&gggTd.Oֻ5兮[gF*]\jyS7:vփ<W( j1@y߀dz鵈W?(A?6/|j +<TsؿE{xAM=G+=1 \Yry n)ʟi G89b:c^߰ytoDlv*z:$x,cWP!=TGHbX&FSp2 n~ fWg[yEh=N`>3̨IYyZJs4W˛O5osS(UnؙaZ?r ذk/eje0KG借v_ޛ}pV^]Ix}w?[xɩyWu1?Ҡ5Z{x$O[=|K:J`x!^޸D!͈ΡhTyunK >7Y%)$s dU sXz߳|Du5t+u Vħ#vMZ?"arpT[v˲qO'x$ڮ?w#{-ݏ6y--Nc54f}}Е*Gd%p5t,9 KW| ?|L}{̈7ͧ=!%1ב~̏Տ4;SuU~-x\5ͧ\r$>r'Nc_h~*k \ #^^pӦ%8R MDG;˨XܢӯŜ)ޜ!ةb7R<{As0#ڼ37멩J>ŧ)f8gzy; ~ {_@|sL)zҽ dneQ,~~Uwy1<#>u$~諜Y,:t1n],>ڗߛdi pIGͷ}S6mDYrЫ4>jhqA[^Vp܃_2ϐ<+(H(t؅fW)'`pp suA ࿞/RA0?~칒A3PtTۚ5R6圄=fi߸׹DVU0+pZA_rg8>7ӷgD1ް҂VZBZv|m 3T_"Re5~Шڏӹ)MiGK= ~mQ~t.j>pJ}w{ԈK*Th=EGY# vAe{| 1o4`/3U׈mIOOP\æk/r|8GE05]-#kpvKgPEB|K> m84u 43Oqo՜]57=t#3'\mO]2t{-bi`]tޫɩ_ wCCTIE &/;xOzҲB/ЛeNBnI</wPqCտtЛMMnڸ &Z\o 0%OyfO~@%  +>58>f{|so!]v_ K(nr7}xQ|*p;wi-p.Y{!Bđ,)_8zGwa.o)L}u*T9WLYO(oc5c&9Gc1xhQ7)I84m`Ez>,@9hygaWӼs?M5fsw`Hrؑ?v˅v} N.OrM<#{ E}P~A[Jz7%َcѹɌMcVRէ=`o6hץoou@G}6oagҋsʺBn9mzKnE\^e&,}-gL3EU..n[s44_"o N_k3Y1qbV^{4/. ?(;-Gp𳺰b G_=Q{qX <*~m*Ol:vWD|Rw܉§rгϺi%To*rr) oIaK\%inK1#:Waw&ƈP.͇\jΪvSDʷOq_d^|SYYpdiG/(Q9^A٬3.%~vI0g-4>s;:[gh&|7b0܀v"5c=&*X*K[X+^|O\vCb;c/>fݰ;nwfA9TڅqO%{~j/>tzfuUJ 3D_XCVYlKO9rg78_R;/yCb#^C3wӻ/;m}r\[ ҠCy/NE":^'yR`!%7N7IQeÓeD9a*E3~~iGh/]u냕1G6O.JuzZws5dn-N U;?p톽XV4z>QmYIRCZ/e=B,]ʢ^Zң|!. /WPϠҶ%MO+(4::gT~g^vjziQh3f{e7.z-5 saf]'K3G`6;a7@3YaO,W6㌱BjWߥsے'V2ׁ_ u |~a?p=轱}o(_v29H>[Z`ӹR=w S'^\"oݿe>N4ciȁY>n.^\:5N3y?t6\. ]wp&P$-2P4ΩlX򑛃8#tM׭t>tY:gwcW6< 8RtIIp˸)w՛"!7;&4h%ޙ&4C儣ۇiIkJ^'%u/qQu]ۣ" R&"`0 ! ݝ5twt"( a" `ߵop朽W\Z6yNrՏgw[|5qAyF<׆Li}w!.Ηk`1)`HIE-o4m}&ƵwPG B CyWAm@/0s`{D7m7򞢞z)YP,F9ju,.%sՕ[G3n!aoU .s· %Cnq"+zCG+ҿ:%Lax쑶"=%od=|N6"]/A<˙ =ȈUupan7p~^fqnϊ:"h皎WZtׂK]}CiQIƯxI6Gz %Ļ#ǁycn> 6^<l L 큾JB\#7cgo|F8sW0%YҿU-{՗//GoPk*B&|R[-TWZ2_5`oHt]t83x6E1lx7#P\i;K{#^AN}'n'rꖾ%oUXTMxulP9ɷo2?˕9bla/HG~Yd,?4a6.'o4MMw{I?0geG*;`b̦NgM襏_[wC/&{X?Ï~-Id0ˏ D;8B>ɼǗ< sAP`>Te)B A5We&>C%7+c:<Ǘ OӞfT`CR9vߵ7d5AB #}d0#N~|/~Vֿ7ow_~BYw|ZR)=]&B-ыmyNX1䔍xrn1CC.4zҚiKIESLi٭iEngLBpl:B鍴QllxbX.Y7uȶ_S"cm3ƎxJ6{+Kӷ  ]>9ndCG&(}Gήy?S:5q|kGIǓ@_rvjcEY rW4jʙM/ =kۉ\O fVgD<R{@꥓8 NS҃ΐlEwFw \#X߲*G?_}#Mq?dI4`}uDlpg3nPC#) _{*Cxk<~Ui4"QLeEq6ñhvgI L SOӫp?s:}vpL&䑵 st3B{c6)T'wB"a?*dƂ SNHy_U)Cvfp<*k)njo;]7.Ok\r9~k=Z%*8#yŁd /*swCxc̘ą@O«f^+璇eFI?W⾼+o"an@o놄q`Ee0ĥPKۏ˻3p'7m'U srz^*yHn8wې,y;=7=;MNXRu_z.??Y)edUmϲu'Leb\vzR7wi;g%&VPjz2ڑ,a A{t烲"Hg8vvLɚϿ_R0ixˣN^q9wz8OkZo}|7ʸ:9TܦO Ks//fT+ vBI/\R[B֯p"ϽM >,~ ~[Z>[A8*H~T&uoe EwMx¯-F|{FXQ1*r!try3Wy2B? ^CQM/.8mI;vW>V<%2S, q#_Y:oBȱz,oD=w[1E+-_=c \mzE|I^ ⊮ܗ2q*2+_k]JV77Ny-QϻF3^@IkyZ2p < i%ﳽ~[њ^3??: dgf9p] UĿ-b؁w1 M*>Τyx+6EgpxbeŤI{eo52ƽ :*"Xu— RANmzሸ,/ϿPwp Nܹ oEŽG{rR Iy !kGnzt寵n1SKvcJ%8?|6p3Bfjw sZ^ys?_4Ru) |(WͥpF#pN]nR/O0Â=s[ u.۹itZ˴򓁽u [{ roti>koxk璋hTqE݇>Q_4Th%{O3]'$U7 {)eAO kA^vX)eރ yn Plvd5'k[]N^gm =Mbq4jiq;Xa#+? A#7+@[\EyGn[gejFa'˚N!Om.8|(f(z;g݌P"~]_faP`5hTgd}n^UM_ V;թF~>ݍUgj 3}o?,t|!U޼RC G@`9tѹ,~ X2ڍ=ǟFw5 ]f \(=ߍ/wwFd[_u/׿H/r6F{=ir%<%ux4Da|ݧEE𻚯vi(oRޑGZe*GT۵$ ;L4j!sn+h7KfI6޶ dfQNݘ^o ?`i'YJN]=/3L2O1N(4|#Aܓ5yͲd?.oͅܞ+4^y+hسg}=yo qhX~ \w '( xهikM"CSEk7eiQ&mU={4?ɬA_FB 4C4 ЃKalوX4_n~Q6ym=0؛ v#]my{2gw}?ՀF d]OfіˑI4+S^ T͎%J%]MڑN3urq5j Y{{j3"K_xލZ^Ft i#!- @^Pv'@Qdnoێ)_5Zg3!ǰa~1q0kgrCk:@>: בOF ~GX+{ \>\Fֱ\= IZ[Hw?]2\v{LIK0O&AV@ |B>uL|k=^WQƇtyE=P* ^)vW<u1Q gYL oRk~`gX`C^ioxh/&5axL¿c7TE$e}t@~kD$|H֩/ klir%x Ϳaohݮ_r'Z$A[1t}kXk.gNZn8y~HTTuXS:_s޴^^<a|{ݝ^I i&1~ e 0/7pW~]>̐g3W佑`#Y`K} . 9~D>lZxxwOsm3S g;sGr~P1 )T\g{Ǝ#3Ou.-F<ɕY^= KH-[HûّmZ^n[Hx&ߓDuj c/h}o1_綂gV n(d#_ȆW<t?ʠ$/৯-_[6χwɺ/<>har1xb]Ɨ#~_g D}. Amr4 tVwdٮ1kxŏqund] үݜ𨫪nry3ppz#YedesUcU9N`d2d-p+qd.Nto,)|'t7@xݰ3aUGؑ}WԩB?FǶN1_Po,%+.^ "e׭Ksxd=nb3p >~ogՈg|&|/09 'jqɑ W2ku m[nޘ"eNN"*Lא~пu*Wa/m佩 bONB%'pÔwxEpQwۑ;"m&I?硏؃Fҟk혯]ߘ;(u.gW#V@n~-O!+07}sQ1tw.tN 5 .H9`|\M?hFRxD ,%}WB|s{zG ;'~&\|ú;okoo"|[e7OyG ;67/i;.B E= ;̒2# \_%CyY< fõ/Iw׏޳5Jy-sbS/BLǸ\[Un+z[ͤo3Ag*?눞%>nۑt< F'AܵtnLnfhN6 1!ucl / ۏo:%7LK95I= H38粧>20FpqveeT嵻Չo@FGH%;O3zN>Cr֗ @SO[kdy+'>剾2wȗ\5d{/>#$<~^QNU|_85€>Wfe\(T3aGT`˨6uEھ:CjW)A }.+|+gWSb ru[yOL <%{/*L>qSH:xTxo?\!f64*>.Y!]<׎іΌ>kS:RƋ;DI?|q6'jo>|c=ViAsLov`_5E9 >ͿH|&Ԣx)^]%.%m7&4p;9̾#~o2jZ5zsp`+߶[W*$䔑C) !KTRa'vQVEY{ U孬d=)CT|_;`.ЫЇӉﶟ41&MoZRR. ! 7=FW _^a~ 4؟ۘ-3ǭT(x( K{_wYuا63:kE.N/C^%0Y5>7dR s~RGlR;&O !}M5֭Ny_&W^Ž2D< <_yIֳN:Iͪ4וJ;[:؍>[?}~΁xt-/r}_$_~և^cׇ/ ٟ+bO*]VrRgy}y*}ˊtÐ ;ai)Mdki/Rp2)y_Ed|=j NR*CNJ'yUX{rW "y$,=Y7L0L~K57,qi}|mCJ4Ty*5L4jp3#B":oDe\|LU) |vtD{2.}#쁖~E 9Iy8/0(^^sgiߝdOJs`wxky/wsVbz8K޳i(>! ZoiYdtJ/t0^|j>oyk>룅ߕdݠm&8Ťe=,'#{McNcBI=l}Oe+s=-F D[qaw~ڛSvK=YKS>,}ػH2Ϻe',c]\(AYĦ0NE֧㾭 qȧ{;fQ~\aYlDSόM=[=5{ <%uz{=NeL3/:OKOH ٽ}E|y8LwNP$Մ\~ggbvz!p#@Pmbs̷(>8ϼ8鴽KoU];\g/նs ;M>^#0H!ٽ׃ [+D/gY,vI~/CY_8&}yZq뱰~R7Rsl)ַ EE}q/>'z)7t>dI/3wJa!,c}W''7VЃwpQ5 JvӄW'Si[7a~4+:WnD~Vڼi6ϗ`Uvo'C_}y3{'u,܅_DQ ;Jy!W6wWx."zuzI;ع 9/Bc?*_ !>O%]&y㛸ҷ73⠵A=;;5 Ӣa僘WM6h 903.`SGOؽ`~5{%ϝ8 s+I\F%Mzݍ0NZsdg;CMXP?^T9ܱ6q_uv ԅ9 !o򑉡#Q&O2I}jjNC+Я»`؟@1f78Wނb¯ NC߶4qo!>yTI; >C֙'Co,UMM: 7;/ɮ.a1Kg/ͭLt8Vzfw>}E,\z%~upTL.Yxh:Rtq(8iYt!/fXF{)w頪$%ao?0ϸŠ⻈r;H$cb=)Q+y5U>ܾkWNrGt>`ޭ~bw<|cuU"dYa࿜|] |ꦻ~ 50OqtҽBA0'(>|X[ EywW,y7@vWI[yؿ=dS%sP`<,]AcRrNq3.Lþl?K7|F[%{7 Y xS/[dÿ)]CA6>4׽OK[!>b .<7.-ӞMɼE3k!t~/yp{CL'1d?*O/>$DUa^5?Hq3)Nc\mB@Ju5mS!gL!9qz-_L( 3><%Y!ەҶYؑ͌?dnZ*v7IB1AMuSփ([İ`|oV, o$vH5$ ]q;W".4׳'|61@gߩȗ372UBTs4FOބ}ʹNjg\YGXĦn=G 0}o_(6޸uԉn& /f]c5 ́wSmG>C_'esD,I_PR/b:ŏ=sunMo@+Ih㉼EM~hKn{'/}?BÙȾ^v O.%<8l$(phםg˰oIݠpw&\J%-(#'_Jc%B8Gk&{7NA13/g ^Ŋg>][!`wjJ:_{b]KtLGv/+iQo?WcI4q'̸:t8zd"Z~9ʻ|X5|Б?׏<ϏfS#4w._|_'SwOD˳2Иj;s3tĠ&exq/w($bz;5dSNL=Ot"p ]G#Û 2o>{W%FIFS/OҏxV)дΈF 2ب3"o1yY8<q͸ߧfEԽMMjX+qW5'HP#/KoJc^1HצMK`'A:;*|Q{V}`c Ӭǖ:S#^gprK|]r2tރ8[qs„'m }5ӎ!$ >| 9pY̾XhAVVѪsO0~uQt)5ΰxww!/|y-4Mm.=;., 9Qc/F^}<7Eb _Kz9'M8l\7+#orŰ;VT 6;ې_*%ݩap/ю#o;^/\&sy<&?Ἁ&ǯwa1FzmWRuB4;`c$}ə$ylNxēAG#S.]:Z1@SFo?;pֻSR1gbtIPdg'xSL$ ]ƴ2 O"䧵M ߸ܙҺL-8ω5}7.[1}Y-&yt6gÙoS--G~³"Ȋ{-k~so.)kD8pdc*@Ϙ5n r iziQy $&r}bݛ}%jNL#7NےAm\M?7maM-IKOH>~%.jͱ}VG\i)hzz`EY[K/}"B/ˤ6۵҅FOӬbŷ#/,jdݖst9Xs(פM\/!7KWE_xyF1r|_3>nBW}; pw1 |?g&.J3w3"4ϭ[Gzl}y]veƙ ~:LdLVjR~az~lG'IOQbp⡽V`Q/c)wn>dK KI?--🌤[WЏP'yor?q5V?8~|Y2\MHIʓ>}= ?`]y#/GO |LuG5_U,|<0Yta7R_tch]e'C+`G?X`7?Bnn̦K/":ygw{"Wxn]fȳeӮ"0L]eC|p9 q5u=WvazsLp Ŀl{d!7YC7T^8 Y曽ds}9?cp%WT$xDs5v9v\Q2u%0<QV6 yFޛɥ+[G~6j'ޮX 9To ßxԤa2'k[t-&/_{ջq3F!{2wKC|ͮ4> ]V_?˅!,+W^NZ^Hg.Y "x% NhM!=ynEd̖;^4zvzQL7 7 U]n }z";,IrUfyCG>Y^s+ѹ')G.'˪*հO- 7_j$QÔ;鋇0_c޶4X\¹}Wy -ئM>x$U[&M,jδ G+4y^_ӉysX_CƟ?` y/V` 8Wu#xA`g|ֲe\9\gהz_** #߹q,&/Dv0 r4䷮.U-d'#ɄBw%SzؑYڙn%SӟDPm2_^ڸHx|&apgvP6pgǂX<Ŀ (څs~KzB/9kԍעg?c$E P^̫ +̂W||{() ~yD"ҸAuOc^ы&n}-+pຩ_ ~}r/b>MZ~A̰9} ʒ l< \~?L-!& pc7|qr^ yew~;VĘШy^/J}%~;=kᷲiK_#JYFuKܤ"-M,[e-xl)3ÔxW{N ƥ!Ę3vl-/%gſc ɪtp՝AۗB ܧyQnD{qjIF.u_cR;Ӯ#O|RDM]#Ϭ<8`3bub GF }j'/q͇<NjEJj_96^)ZU,N;Y)?9.^\vq74C)\泱HT<7˾! lKWi{so 댿]5 xG>=ze|Of$S4.򮊭m⤟ ynYpXq\urf*_$Y_W#~j(GZhDߟY& xx}wL4Ot<[T-EQ<zo>7_jFqkcw^'˙ia>+1kMR_x+YBۋ=?c%"X9?ɲ/яV_ҿ@;~Yj&[._^+{?Va o,Cݎ'oN+ic=v) ̲pRڸɐ7}X%#v3m&*m >đ׮g"nvnSl- ~<%/6"įx\>!Г/sV6+.ѿNƏAz~[\*bw ?̹+ bꆏ/oƚNw'(? l&w,8<>L{H!%5 &WSR\`_ lKzl=:VNG<<7I1[D&5geOҾJp/'$ ʺùd|X[gHa̋&!ӋsK ڶryRDqV.oC^fsd!/;͜.J Jq pF)$nSU=eed?Q}]8p|:sÑXkA.ɮCȺщS=G ~Hbr*GIܮ1-/RmTmrѴ$t*\=qd~8u/+®;,.m ܋Eޫ.::-߿*.-l ~O~c孽%Ob%$| #|Db,xS<5~qZ3Q{ ldY6?^ yI%-#e ֻ/k'U3 b?Gzvż0 )ǝEc̣ !-{pCQԏ'ecY)}F7ړu9R_ކmMƝrgz'Saaな';IfX7ЫDYO*G7BJ?y<1:g؃]2G[ϫ_糸]B deЉ%w2Z?e?Xf_\"#z\>v?{Θ鳕YI=3s!w;Vs}~O~. ?ǂ'kO;::˂?ņݥBe -ӆf~;#|.ݶ|H!N.]*|QO^ykPuWr#h uU͜/ƤVwf>44W_ܺ+#=a#xA~/o >/̬/3ot2].fߊGћ<=b 17em,~v{xqqOaOFXM{ #nJG|w)o+0y2 sv'K[_RRUBiU\J(^W{޻-IJ.g2BDVF~^o^^vcq?<9g(Sd7y9A["wkOAM筍uӻ]]'? `o"yo_iN:Z~27ulCC \ے$L~sm; %h)f|=Nu_}??YtIos~ ̚4e,ԱbbtXXi!NE_W4*{5)ȡ_ [!NEq]>]+A)BOgB;f?sH WfąWJހ_@~fO Y7F>9L{_"Ug+b8E?~?t3HF(OХy' KBnRڗ|.sHp[~t:;zO| ~!K-U;{`M'Eu&<7Ŝ'Az}ݥj{d簣1C|(Oڅ5|SȞ( w5a?DpgƸV4~_ ;O g?9ϓx`. ;7E/c xn/Wc&e >QxycxO"=sPqpOt:`h_+Ɉ[ qְS w^ |t6WϢ|K&xݤ:%>3?Kа#3[O&*9y!Alc01LcP=[u;_aEYA״CAAA\͒~v_QrY 5y:fg?U[g%ʁvE^5+!ċRoh{T\7NCX"^q2ݏO3'ȇ22L$Gy;|J8~yyMoZGU$!f,˵?5uϋl@~5?6sn4ҹ''*^m>sIUݧ@ E\=4v_ϋR+m_ T&"嫘v8.vTqSwb*ҹ! GA)Υt2spp)-A1*H 9`K849n #D^[F\09rЛǯS^ڲkRezޙX:}oh:ϓTU?"T }}R^.3"T4e`|t3Iۮmx}KskT0O%qtuWp=Q53E;E'`_~cPESdϻQB$_迾m.0:7Sswo2 :][sիk.y/Ph?T謅q9MtYO<+=.1Ӧ% VOAkӾӲ;r S WN_\0V;:6?.h7j}vV9ߊ3֓p2{ɩ0_j} ρ3P1לR Ϛdi0T^v"Hšͷ7Vm\=/Wнϻ_>BwtBh)(n1tHsJzH )DMx5:p6Uؙ*/0?/PǗ}y!ך~uK2 ]UN;UJ;/g5❈F5af͗~9'Ўf{m*GNibB3+oֿ98&Ňs v%ڭh7Wm# V\%'}| ) 7L;-Qk'o9owcvtKk=zHrq`j.pp?}cm=69}ajKe{>e[a2reU8P xuI|]1[ ,evÿ-$y{Tpɉƺ񆚥+iO֎zR(ȱR]m OC~嗠?.jE.3ޘC&1{`?T,;߰ WUԍ$nU6Ƒt<`1" wut3Gm4{9Mo=Ot\q#w$0 9+Y4 < [R7s +Ě0kaL eSl.zK ePǥlvK {y%qBtn<:ϹYO.[&Nt CG\$=^6)}=lهz(Tc9Ma݂q%,DWx"yh4uj ?pZ ]Ly< . ~N~Py?V+L K<Z7lz'7=&zQJKH%!׹y*X}oA=&A~?9Zj'2z*? ^h5% W?7^ɳF ߎc<'@א+άG_3Eh̾潞F" Hgp44?4->rx]pLǟ fX POw/\3|=87'u}Ō4|'~%7ͨ˷W%Ey{'?O㬊O8/ ^y3?gD7'YwÎ}y|3m::gc?Ǵ8=Gg?rkgA]Zi_h'ym:m6Lu<8i27dd釄 i>oXs;+.-_Jz1r\߻UlEkn>CNcS?7VNB5|̐rɭW"xr2{^o[21.A1qpB'' !NJ2AsKW%OFy <^tYiV1yeZik!4n åh_%>V@O LmɿrynUȹl#h8 .;0oNDs+ ϱ"2dُ 6aI>| [g~+k=^&MKM󎂏G\/<]mhq kQ~R'z+ADPgG١#|䝫Hۮo|Ky|2W9L1j3gg΄wKȣ.l.G}Z;i62gv;3` Wo7dˇO2.5{kG6KnĎvgA|/sez'~aU}`nn⃽s)_YVBZz(݇~cM |8| Oz:şy ڟZE3'߇Ȟ팄=z^[rhzvk6Io!VvޟvQY]09DZA~{| %aDC7zoɡ| ?~zX56"&ES?e.=oT֣G?m=3Wa63~-$ =^QCOcnB,Z7xX>c-m{@w>FĚx |rcCC-p7z}cR:[[sX?y@7 ,]s g]ipdq~w鸷tfO}ti( g BKo0ry#`T:p N}-Fg`~n]7s~? q<|(9My;~?oOI|98Ξp"pʲȳgnQ视&4Zʏq;q5 D]HJހϖ,:2ΖUqx0{)ǎb)%5S\M+7!7ޑ'~?9c~H4v\65z75xz1O5:fz`,z"*u=UFP#m!- ċx2soз:E3^2hBDL8[5}[ Mg9U8=أ"m_ix۾2 [jxxbV i- ,},S;ΌM>Y~ٟ"T~@]ǜ>@.4ck@!M-鷐8%ۡgN6Qb0}L'\;L%ˆ_6/{g({Yr|wT6 qVѼv?#hftwSx4fA>N|:R}vMʳ&AqVײ_-vۏ_pȷݧ0dMLsYX㴆X{$vY Ŀo!Žb*:7A. #nWM o^uAjL}s)d$;Bo09?6Bn=?3&qKҦ}K=: :j^*D>c f*]пOIL kLkOs1_ǝջ/?Јy T'<ͳNqU^ Vh7S־ejO΍F;޷_"=/bo(]<\ۚ7_H{P=g7?Bץ)OJ}oqW:yვE G/)ט umu2-;_/')g]n&z>ox\S|鳚P]B# i2@z 7Wң, Lo֯Bg̋u6v?e2䅙t|H۠t^S^8,[(8CFi\c!?7!`{4QdZ3l':+OΤ<ùsW.i}; OYNZ krSABümawO^P>؈:8'N5?>I0Nx+<<^ ffX~?d^=NFho_m*.Y`nYffHveΏ~7VJ~ţ+_qS .km6߽"ut$(An(uOa\ ~ eI=]^y!|YϼB7+&/$(*upVXk=5˶qByҡCB+Q;1b{ϯM {3&WV]$@Ufw}8dtkِO=Gk; v&+}MصDۙ6 _?@۷s3׃{AJeځ/6}1ӍBnR*ihhwkMiO O,]{NZqnM` Rmk{riV2۱KnZ;dNs1{?_pXc6)F'yֹ}E[~$Wz}ogeykGՂ<:؊GpV +&czJ 8{dOza`r~KgDAdW?u?]2]^{, Y^g6Շ_'4䳩~3CTTץ_h,> dȒb~SO2ku7sA-{^R9/6̫3TN hw[ә ΖoONM2+fGB6gǕ 2"B.TzN 9ɔt/8_u?I~\&G2aI0EC ^Y*CW|G?iW槏$iXA\VYYtA>tyȀ^ %xl^eOy* σ_gB_CPm90I3R=(殟>w)ii/=ccv-:/bA3z=t{n}3Waك0mS~[p:W(im!9.iY|S˼rTZ.ol9~q]G~ C?v\5/Ϛ7xN$gJhpT%pV(9bJ1O`p\xUoz~-3hY7 ŸrBK .uϪ-kq'FcRӑIR ޟ8 LL{MQr.] i1ߴ \y6^t1>Ƕ Kpkt zPǵ~]5Olή;59YET е_A49t$yyhw=|s #tOWsATIvu;=x-K{yĩ וgzi6D8Zt#Jp:dǥqLU)ch$a3/C*}|LL Xq'(m\(֩Dh@x7tp-Zqo;oG[ev $w"׽_R҂L(b+/WCZ o3sؙb۶Ch ʓꩄYݼr qKʾ V; ?!ezv 0mI-T9;/~_-:71oc3c$輩Ȳʯbҩ}nr~6#`TY.\!H=#*,ZԾ9Z-دЫi?(=MGyr eVC??R?z$:lPI>R7EC8,^<U?i %8FVSf]-v`0k߼^?~yjۻR=,Ŭ r7zSeϔ!-ұ]wfp 8bVKav@ɳ(ph'RAu9~F| 6qCOuZr*q`%A46 6ϴהE, 4ᯄݺ >Ep~'y[Q<0xPt?yC>$K0 yw^Jk : 0>} ;KBQV1A.$gzk>O2S+{Һvxav-_V?˄[5WUbqe<HPf!o/o34aS}Ova9 k,~? ~dEusF2a>>7Ax(p~A˒ӿEHi3ڧݼ u"P:w٬F% H|iJ.4V7χHJ.~9= =2|#\4{0_~Vs}_տ¸R|: qDϸJ:gE}3QvxƙNyu{r}"0^Sg50*e?譍j' *Zk\-Oni}.E.pD-Jsl*k˗pse/}ozn:#>/Zswu/sЭ4oɌ|jJyޘ* fk=%.80!ȉŔ/f+R}ۅ]*UYB/!oKAȇA~ݭіb'L';i,H'2E<+g},?`Q~SXfj> CGfV΄A_VJEkZMa0^/֡{b'*?ntv cQژ6C >'0{/ߍ'>fXmr>셻2;o"- %4(5X] ;Lf Bs..A;2u:*>{ksEv%Ye-F״‹ivNf `>81*p^$12RUu6.S[??C3_0 g9{6P]08Mch]0ڞ+a3~}ς_U?]ޔl3,))eəQ?к^}-on 6qv䫨7WDy7'/z_fTU@~ܹ-h׿V'` Vq.@߮viYJ ǯ^z xY!YGW"}Tu~|~*8luL:2!e%Yh)^B ]ӉM.F8y1Q]ɟ/Gcaҳ._x~z*4^U8.ּZʻ4.Ɵ~N2p dccY$A ՂлɅ+ Ti[~z{)ψ JF\2{y  ]_*۳&OB]Rco ^zăk6ew qU(pz9kA)o=WȆ+ -N,3bi7EE|Vް=۶[fpIP+W(p:m+sI\~qXߥS@NJ5_rsH, Ouv rYbU|.\aB0Kk7a-6lsiu63@iմv=(OʢbĵzZᗧ?YYKyoZ>E$/ toP>+xtLmԀy' %jya% '%F15cp{15w?q㦺t΅*(s:mp{'ʣМK{:~eᗤHj䢩2OeK9# b#GJ-9,Vo-E;:Bt.5:,]:! |{~p7'W+Bk1%Џ'nLs H{xA9򞵣0-Ā7Ib`/ `Wo4ԼxK3 |lÑ_9Zl,s7l' t[X3i)"z/X tn6P= WO(&]L`U818+TLr*afLt`riX- \7{@CU ?ajH\.hm'#;gľEWgP~uKs0N˫GMvAir<ȬiKC>~%]8#b_i3涛jwaoq-J`>.wQ5p3X\!:)>p7jk#vr|#gz"o t}It웖^K(h*_ςacBN:$Q;]4})o`>a hɧl}k_o^-)G~QV p ldZM%t'Vө/OR>ڤ/UЫyݫI} TYs]'?1H9ˢ2=u 3ؗq{l+08 10jgTyWO/ ob:'M[ ~ȾWm~je ͙aϫ\1f3=X)>5)W8`<~KS'{7Y.)Ky$2ͳ8N%G֍{gR/K_9{0@ NLɧɴ?|E(g'~>}8cYF9$ҾҨ)ۄoAR%n#;jwffdF~18pXS?7<%rO ;K;=+7ާtDN[t%;#\/qּ_z~no'yԫ,٦[:ؔOYCqg;V]lNy!6? NYC!ԚmyxU) X4t,IM~VٜlfF@y:p/ UhMLAy_ xg׊ n1C ۼoWZ.y1@CRE@72e_,M !ޡ{W".^3>_oa yH}:h|Lv}hŕ#'wց P8{󮝯{0ji)/L3ч;)jGvTrܸQ==MX.ue+]և^w\b:fM'nSNз'H`i~nov2<9y)/:y*?L+apηsq'*U_/,ZǢ*zZIuVKQ2Ss.A;C ٔO$q1=h3/pu_/C裚ه O+4u8klu3LӁb OZ3mtuJ⚪q> nH]r+ L3ʀr^/?3I=t37{`oOP;mw'Sܒ0ToE+YCUtڸ'{z9r_@_̌ۨ ?}Oŗ٠[:G@urZw޽5UuS:$(Dq\)g.?? >7|ȓZG::umk~h7ϻLB3UR]$7Ņ֑;[9{ oE5 4! \,|3c֮w[BbGNI7|+U ~?f ]^6D->k5X6'j+ %Gpcr]"{t^1O=~_*5'ڱ?峣P'A'GM}M723Eɬi2ݻAݕ2i!~ xKy/_oTS,1_߽ n⩺Y1wZDc8J,a9Soz/ >w߫bcEOosXfӖ:eg,}ʞjpݧmb:aqW0Zϙ͍m{>",|l2ۦKcZCKO?4I[e5t*I}'%< #g7;>h]y\򾾳sݓ8 G|۪mL}Ms=!-b / +q{Ws+ ~= ;0, ]=xvj2w\I׃߀ݭVS ~2=K_.qǔmο?ʣ5ɛ7x'MyھN-Anok}fPDZę։W-gJ񹫗h|BMC^-?M$&-TF|HV,iO<{}(nei>ȥZPsTGL\~ \4ps|W~oɋv2/V>:;L`w̪iWZ@]!Eg=]_M޼^oPEWM%{߁s$vasُS<zZ9n*ƞi%su`^!z3>a޼7cT{) wA 7aY%;kd؁/K )'}ダA{R3e$fW>ܰ_&AI lGn }"Goڭٴ% 1!_^OO]unjd簗1VZ)2W@y\MBy5h/`/uQգ/TEM~6}׉`,; n^j>tzu3 r=,zSi L5 z%/<5ߐ,Yp;(Ðxo>r foY7_&Av|E|y$|b"e7_fdsﭞLARKqw^XM>5yՃ=f?bbӾFT!QQ2?;'.g2 W;eyoӒv#NOMv{ FZy۠y^۱|C'kXhj "!ʹe`7x':*L&gIג|OYrJRElnXcthojel ʓ-{rtO'[| ΩW<vxK 2u{lVCřUc[2y-p>h߀8/Ix?L2l-5׎< zaETKhÓk;{~neJ4ݾ 崞9ngؽG|; }؜u:94q =CO'xYR!XUtnWuvE^>pg+dCNgni߆Cms-`W׶(`+L)RLv<>rҍRʃ{7W_Q`/}JΙ_;αɪh7V}Q#ܚeb޹ Gn ~{7IjUӾY;9%M]̃zg8z7#^JYeHV-Gp}`ω/tghzjd9j13P5+G; o] -0xJXU*?.ΩscXOh7h飓^5#wAqhTǠt*]?ȏ^81Fk~en]~8@Zru!n%8FYp_AG80<X(pP{;q5\z+4k޾o/^|&}J ВF?A9I:3~It#6qJ,f!p&0/g aw;!͓Lu>%Qhw&e`iEGލtʃ5Y%X{)?xX?Z.?˯={dMt p|8ڇn1]egvu;xk+~u:5 To(+QxQy?bnh֣!1 7'A駎!}/鞨'4ngоr~GN..R_&?Se|y#- ;cy+E=O޷Y {xw3<ʠq7ߥ{OiPA k0.aȝGS4>GҐ9c `'o;w̯g)N}7`s3kO2BdG կ.M_f14i8Kx ~yw |5펢ZrT(JuOq7Uێ_({] %'<_!|S%}FTg?0w1g`l`~]kD\g!58?9 y38p@ u|y1F;s-;.;t7$ pPd_͝{'C^vVspEa<) {u*xߐn3YwLc٦LyY TS w Ock&Tj`^W8X2 7Ow1ˠY7A/V!ɞ!=NTiy8þ)3zK{vQ!_vGfb>|`oTm!bϜNWY-]];[wT6Lkxłf|tí֌v]2Mjn\)]Y5{>{m5a]%WЧˆIg)|R,ʋd۵5KyrIIi-IҺEPNwYdijI)q[AOWc@9CnhgJY\3ZGMkҙ|׃EBm߇OqAq=@(Jkg=WhzCϲW!NJo|/UyD+!S'r}ZwpgYG]D+AN>]&+Kqd9ԕΟiZ؜ݴy"ҺxP8g^4/_?ىxktVe=`1vOJNe_yrr/}*KWZ6bNC~yW~AQC\1 hQB49-.k%oIng]k>Żt.8vm̌ݺ277ͽ|W OEd(/NV;$)R)|t;nuMB /"={W&/sP&צӸAn|.p_q3 9sStk S~cĀZ(:sj3]!z:t^M8N_ZL<'.N |c?mnE|c.1k UN. Puo=ǜo >L6jl=?Ijo]C̤1v>|N^eXu׊}foi4R%#hƏ)~M@۴?aWS?[Fs&fK.uq, ~( 9 l*Z)m8 Cgn`L5KeH :$yNa ,\&[-F͜{ɠSBЯxA^ȹ/I.-gͧ@G+RT7kʆ#+=6\!>n}<6gn9YzdjD'n~rWݒVTM]g0ޠu*J#`Z0ɝ/'>mVyy<{s`c%Z/;5=?͢,wtxZtY=oGyjh'h׶kY^~ s ʫpi4ʫ#M ^\=e+|j RlOr/iUSlO?E?zn/%Q^ņ`FgT+n) os_VV{*p'p,hN [ =+,T4>YbӿfI{A.tϨ~g8<}vQre>2OlJTe(\Jz\[y#Rz,qyjB>_4Yy`-x26>9 C-|Aœv ,]w<-TV%-(TFB2왝d$ DDC)m4PJ{s^zyY٪"K_ =ST7C޺M• r.{>a>DVܴ=9e#P?r|Zh:^snv?fuwkR*Xc3txR/VVGxP}5}xl'i$͊/5y&猎SWDzȥcC$gJ1^ I:Vu>` ŠЇlo^ ퟹ !} 2&TN->)l:66僄 gp <إD_=9,^3 7@^E%)3(o;$nչZ1?%~%}Vzvjed 9pY˃%#}RțDz/}Ӝ^͆SON^rǧ`Xr)ȟhKW5U1kpr&v뷸tGꝬܐC`eG~rߊ5w;BƒcWv>A+qBn ,EnjaoݏɵEk1mHmn+JVۍYd_ۡzVGƮ|7qz_s5Wb0&VES؉h'2<CW*+t"N"x>׍axZ./0Ӹ)b4tTr*¼z_&)UPcL  k5}=8e㵤>(~I127)ҿ@#/韥/{yn;i#/m \ ߵ]e^)ʢ !Uv k lb͒a,  ?yf1FaNY{#}[ei2^%VN0Tƭ]ŀ<S{~;>vq&[ZW.LD`\k`;%ω^}xߪ`SXw,/ndѽYag;*&t=ݳ竃~ݕǒ;3YK:D` ;ΜqC{`>GL `ҹ 'U v+*"J֋v -w~:snqȾvcNK`P VI%Gl޲f@NtxA o7ׯ$'ee:OU6CG^v!{g=]8;/S()ex)l=g A_ +/V@~]?e@caό_g.yRfr7{w98ʉ1l~(g$ >e_nANذJ=N񠬑ԁsUO~hGܧ]g)#?ӧߓ8Oe%uNu[Ԟv^l/u|(6Ϭ6RDrBiÊcV%[$u2m~Bײg{V#џ,6D\.]q%xbJGφro_9wNyRjC,my]Ombd+et-IS9'(ү{^^W݄&&ujT `Wfϗu)Ԋoogz H]uq99T=tLHt%F/#Y*oM=su/ژ2'(N㝻a9q^`.'DL[9֑Ѭ"|Aq ~vzXiC/H{X~xS1<'*jH Y_x:IpՐ'!Wwެ{Lz73Sh@z;%J-bƻVQ]N ȏ}ݘ_IBKX Sa~cY?UxI/M?08d_g?nG\1V1Dnru6I|yyd%Sk<<": cS}He1g߳ko`~Fv_?GOI} S/uSB'ᇑ"Lԃx`JSQE-`~sCn;A>b߫ ;w"~S%E eL)qtFv[wnj){N`qb?Q7U OAuM)jvVmW)|^L෧*!+m~pcm{/^d1w$ydܡ A_2`'%:E~j'*͟*.u'xFt8@UTBTd2IBfܙIy؁'3يc^^aql.`^S27i+~)6SxoɆڬ!- jPQ ~to-{uY^t~F΍oA^e ѐo]I,DYW?q% PTV_&ZUܷxX`{JK83ӻ`Ø.s3N'Vcs/\WN7Uc>;,? 'nkuakwnˁ>d]6tI_SAW,Ale/—yG_=DFeX$o^)>O'y^ ޅC%-z0V]>["5骧Ss;ȡPЭqMɿRH4Ѯ=Ƽ ^:e'Z !La)~ -]6^YyGhyk!d ެ*@aR-'kLC_ r]s9pdՖ6jd%&*!]4Wڬ+!qR?y1?w'>oMga+H^JQ 3oBd9ԣ'o(碰J= UT~;U` +H`zUy[ -3\ Vر3GbQ oOU/{U.П㧙 -~sg5p'CK$hVcX.n >G'uoDʒVsZGl2!_f3 lVˁ_.eUtMߢ[v, SF]v 支A3x+AD 'WIǠwSO[ {{ɳ-?/ .|E==Ӓpp8/q& j-#Ԙw{l~4ܡ vx}٢>ǜu!r֯%j r.??I~=)Lgi7rޞ\|m5٤%o̎ ~6FN;<vS|S{<º FQg'W*)B\G@/ׁ1s|Gۨf1ڐ_l^gnbmQ2;&cpw~$Q&0qZtѭڷV]f{z.HC|;|ԛg-5¸q9?,$~Ճ;#<$ + .JsM%^$߿`$]ճi%_˃|"Ŝ $\c|>ug!g;鮑1{2gm{S{˴zV}lv^g7̀9;_&ATɈYYS<=ƵV]ktqb)"w$[FU+6b?ڦr;$w3(Pl<32zA}k9 Bec rY1}9?V{Zp8>rt7ee˪+~e3>6ݾiq[?¸hS#>gIo!Ҭ&E\aNs~'y-L:ח =?Sg~BƝ8'cxvR q9_&sw~]z:=~o}=ӋBˬR9Gىq,C|,?LhPsh; V74w>{8 x[PKS'Q_|(&r,_ɾC\~srtKH۶?"s.0U]~:>p!=資%{ ,e@JR1Y"ޭ;UZ<"SC΍[\gڎѶfwH};7[ ^"yS{V?nM؁1l&94|q [r+0h 3U;FaC4]ƾס jUnyH CIJŲT14ER[  (T-=MΣ_vvJQ;d?B֗@.p)!Z`glT OX/ j'}5Ew!f4> [W7COy/ά`=r9(;>Q@NhxM|v |(V+9cpJ+ڽ'Yo-puIQ]/%9z\jGgvݦ9mNDzRA{R4wxe(znR7%~7= =UKPS'uyk>^tȇ:f2:K\ߝR3z^hv='4rŀE38ʅo]@$x]V_ :K_QiY7Yk~n}Ka4jkY#O?z϶nj񶸾joށ7V -H,>%Bl7,"(_Ec-{my~ ι_DeǛAʼѤ g)Cv-R|{ i󝩬!(˪'<^sE,^$m0L< .>$SXH}m|}q)6>M!V`~kr>5C^C2Ks&ÿQg܀Y G %sN7{ $SF> ^(ԿOۼyRYE*hYwVvp/r *+-3H[-!#^`@OӶė13|'B*7^NJ9F&?B<˶{bm A*7= VE˚DU8`^K]{q?;2Ìϒ8EameL.<Fxo'׼wÒ#ׁwOY!" YOo {KO/bu r篜`aLV{Vj7Y¯Yy{dR}dV'vKW5+^~dcMPuz9/O/Z*5Ѩ8x5_~U^_]fx( 3Y0?1U( is[/΃+NO!NE'k$m"aP a!%NMȣ|BzC\tKK8C$+ tmʹL]Œar7<]r8]&SЭ[F iVY5xNO^rߟ p-B2\KXrpg =+:!(N# saNNwr<"ڸI}ė ;sˏokN\>y 6[;|+w'gw5+v =Ա1H_}qKJehg~ZQU;syvsws&`j|G*N,y,xSo{A1#F_9YX8w_.&Hm/CcTԤvBiJ#_]{9(>zgNΰnFU|j}eɚnF߶4w@ECQ TJ nr R]}2F=zƐsD._sgjZs]z5Fz|WHT'mxPb6EeAuLΐ{qN3yGr -zZ@ώxW^59pI`1V;`<>inLW,س~w?[mmv57:M#_\$sUBc"bʪ޳u#+RĆ_=FxcEٴ~ #Zj=+p7^(q'i} w̸M|/cKq53~WYk#tuL S\X"4)ȷluSӮ4V<&12G}gUjq4F]4Y{IZ|$8CH]{\Kq"*4jJAu-jv!5'|:Y/' rˏ1⧿j!6ov [qq[ jMk{I?-vǼ\NS6V)m?'kT 1jGi6F9OOؑZ[JWW I@fI;TeH"?~ ?6ق8S2sF\)atO8Xww]4o=?/l*]d1V:NH?N9'}Oj@,,w%B[=q'*22__9OY(,7K,5G)+S 5/T(Ty2;|FtNXa|Qz{.ˀŎ njNc|+a_v},Sr伣KToRV;-bOdӒ:rx_D'ia #}>՝?amjO ʵOcX_Ctx|km Pg8${'o^iG߲.g)qʒ`V8u|c4{(xVNxyFC#DɧB;g#p0η6?@rt\36y bWu7Gz߻<3*n"sx;zvjyT<3i*[>pWA<"ŤpLJժhB~^7Sq|(7Wq%Ce6)~qϓD]ߚ9$'O<`%($w/.¾N/V$xXCۼR~j71"3$6xOH*ߢh8%@'摥RyB||L )RװZ?kK!g<7/nȰ?~SEo;+ʏ<;IS;^AabW {|>d=LGhm(clfaraD"2zn7OoI9x{`I'37iu[ٔh1E46 p#9֔)A#GWugջ˲Dρۅ77kro\fyrߊlGqg- .d=ͳjÆTؙ)#J7'^>m&4WCk^pyMc#‡?"vv*8C/έuEH.VЍd ̗=QsxŸ@ m7ۡPod2k*p}zlNdwo_EAI!5eR3gm9lP|XGJ$Iy5 3"-;{'ĸ6 mnHmdoW+ >9lM}(K{χ>NW@/;Nu<`G"4>G6#$/ Ka ? w|Mx]NN j̷1}l9*Y(șkM^#; vGrr9@?3TWIcf̑z]$(I_Ԥ#2۬1qD\+ [Ԋ-;퀇b|`YS$λ*xBcTz65|Y[ͫ{#k 7k'`n.\ ?0<{ M;=*z3O"1!'V@]},LᷞdO w?d׍*9y̩gxi>gt(_ e3=NMd_>yk>&V,&؃ydY f8?}-?Ckf _l|ܤ/td֧ξB=ʹw:zH;],=2vkppX:jr;9j0l@pN-@xC;<R>>q!q?b591@זR6GDn\c97I"wHL}C=\RPZ gW*/ͫdIC\Lh;ͬ0q=zn4Ȩ}p*n?_N|iN-Ou_/p:x}Il/0ߒ"d*i_O펉Bvx^ZykMӕNOGGۥ`^l}|!'O~9ј/e=K<wCAW>>x}?s+'{nB~ y]úI2ZrzqUdbٟK+i~ B>~cEvfc?ɾͬ"+\ %v'(rTғ25sx/_҃z N٣ao;3#=O+HO\ Pa#[fPCH WFR※NρIGWKq/[LH6WVSǶK_o?9,I?WǷ!h2u,_ ;MzX{E+yQ>.%/~zy\j{`FjfVM5aAGב>͝AI?9^ l^5ڈ_Z46`\R}]7Z;Ռ,W0أ[-1CZ7IO>o{hڈ,vwgٝv%!/G<79# v+o!]["¶zMy~Lk)Kz/ҫ`W|0!U|+1O] IՁ/+y@|18WH*^w<&~_)rn6:8򽘻H_(q=?r^TKA/Ru?E~fwǢX| +ơd|yC#_dgO╄{W;t̚;CNjj,⑕`eVYzCMn \ocٯdž{ K<'[x}LaGٵ#ԟU^Ԇ8!<uaZN~ UjL_Nn{ڂ8$-DYV!]콄O䬡nfn *H[tN&&>x s:Ǟ˳U%YF^Iyķ(._Վz+4]_I?b1UeAS !ĭu<+OͷEbe+C"^Oeh;QHǿX^Һ?/OmnS7t> (N8gr/-x؁I~"ϻϋs-}k_n- PgJwZ?b7ܝ[P2*~Qvxs+YaG1]ז!^Ѧ3>{Lؓ5o[c]3BN&>XaO ?d¾Mʖ`o95养skES=ړRxN.ZWdLAu/&Wś@֏'Oמ"u\l@M%&q(O9ZV-Av٨}S5-IHd> %φt8jvV;^}`kyZ~XH!*0@K1Z/,+2 b%y^L'&7-U𣄥r>*sImˋxm3uh+iTINr>Ea9,a<w}IG;|_лCGyo| 哯#0_?[yDN6vjS& /|G2p<239gx.dp,Z)ə˜c~c&BܓjAA1G>ܳ_WWs{3"ۧ ^ \s d/]J_wqdCѻc[gHJIbhΗkA>?CǤVpbu#}y#o)0}8~,'nCL8qxp;ay?pK 㤳]nwH >J_Q%'0O}2- s4[T,eJ65[0$U-ߊ2q(W_ }u>I׏nOcs6)Ot+r#o[&{bE\Ul 3]zy5T¶۠:zs3G< ?ٍ]:>-侤ſmOsbx.uN~Wqcҋs!w3sM/-FQǾr 9_FeWckqccjFRQOTJ vo&הݡ0*1;},9Gf8O=6HMyɽ?tÎTsr~C;3ZU큋2_Dt} Mm(4/e=뵳m$B:k(nFpm+Sa? þlAaph߬[IICٻm`;b1bk{Od|bAy9q-!؝l~{[ f N( & ;ՄoA>zI/GA>Z~^$5})rCOa^7s󊂇:DqQA_]dFc]TωAmp7.MvO^y;a FF۞gY#2Hxa}*WArG$irwpy` Xry=1v"I%%9 /6;yȌsWE + i"ZEqWoYR$}P z>|4Dwd=!v"* 5?m(^?e^znsiAT>3}Kq *9W1Z xU‘eO)$~hr?⌛^ToCf#_ +xOU?!@xx%^2,&kh9O5y*6fy{(P0ӟ\7SgIuYZaIK'VI;48z_?m^L7(6 U՚$ F6#J:`]W,r/7K1UOf~𗀌:ގy߈#_4ʾPu)Hjʎ6OΕx ? y'Q-GLl@SJ٢7@ VADOu˾pwKm,|0J~lo)X D!h7A^o{,=m^c8q|.. }Y螲y'y;ݖLZ?㰕߬)+Î$wגSxINP= AGCG >B4F˽'6iFg]WaG--Y4QKn:/-E2T\/r>`O:bWU/}1<#;!j܀;VWyߍ#?su xiWvrPpfr^;E!xwEyITeS)&v.Y7 9[Wvex5푷%u'VBcr4r^J45QroYki Bx3-B/&1NWGfSӰ;GKC8W̃:3#X1 ? KZ[#uOGt&I<X'ٗ:Aku4^n6 1בcC>{DER[صx~ )Ię,zpchz P̻JUTm`^a/T9Ao7ZN˯{ l?+И ~GckP1E9d \s;D j ^RWp1Zp ||(᯻.ޢQwE|PPϭU %\q%Hi U}vK+,XM=i"]%kmyǯo o}J~wh H' >_n75P'; \bKJnCWcQIܜoG~R .Xosח=[Ԫh{Jnj?=7h>M;+ V+i17&r+Z,x܋X2)~i0 2džӝc'YUO}Vt[ѣCc`q|ܰC [}C|<ǵ,;+$4-frM;?2b>,#2-o>U j>̱'4V{bʠQC;gOKk -;(s]hԜ]g[WƬZߴ'ҥӖ *`;_nw4ܞF/G6v0Q T`~'rD6ξҭQ4#`7_Mʾ1#> -\ e15)2#Ti!#v{CiȈM9B,dx?|p;=\|>u]'_v}hđ U#Oؓz%LLs>tnmMߐ-{Nyhbk?TayoROx ?3 nI%OX}㦹 >-QOΖF>wwSx7 *=&ZYgrYVZ_}{?lOJ}]ӢvdOΔHBKԌ|gֹ({F'.c䯤v~򺊅=ۿkۚhI|w]An| uГbpQ#/1ϓ P_OQhr}矇~?׽r&#?>=(дõ^N6eÿNg߾Cw/gg" }|/䙼>C%~RC\PG4->Ǎ73S9ftrYeȇ? >;L4̴te{Q7::xT!!?4Ky (O<~*X:bnyFZ_rS1n*$X-Kx[Jw0?~! ΍80{şcׅ5 :Ȏy[ ӻ:/G< ub䟹7#ywf/Bqk˹ P-@0g;ǾF37QuѪ8!ȫw2'X+a7/n}u~hcS W`F#yv]s_/+n=!>Y~;3_HK KﲺQ:"`]bL׹n cM`}"Z<,/Hzי"7};'l%#߸֡Rq-LTsz?Cw+ [Oue_R|{t/c צп{ G ~:gjq֕f2[y9>.Gغч{T"v[/0zQ#)Mj\`l En󸇤Ig+v$]j3q;`QѨ}rfA<׳v%5{-x"{nj}%'A)S&FnX|9CVzu DUlw3iy#fq& :=pL\a΋+zb}Nl;mG¿?g+1Bw?[V ,{{w2O%I)G_t98mF>Wc"75~Hy1QOVw":Twj5Åς:ţO*X(mD'xlV|s\ԓgzsCnD:j![^"k=7p~~m6Ԅv毧*ڌq<+7[֡_UZymԹ#3 ?w{f7Ll327ƉZïj~sxMK.qWeo۶)~[q@c+SB:& zxZ&I:ݙi-͙w yJֿ/tl ^q[X0 ;avo_I.=='RCoU~O1 tV{ai_O$돬~ݙTFf.Dݽzˑ yϛy؜FlO:Ekx* Kkդ0>e-_˿C-uU]pݕ/C9=J:[!@ ~|WຝaWv#/>jI='cmzF:{W#,8:@QUlȷvi 2fZ<|ZgxE6m&;E}rpCa9=z1$0ާ ?̱_ (W/ݯ^GRa8'lQ®wi^g",yO¯s՚.gٶo7b>,̃¿f|wC-Fc%vCQ{Ay~Wx[{`%nqǃex\ 2Vkul@ޓQ`-'Mb\SR=Oq@ϢyoMB=m3 yJ}W;E[yZ"=2s[<3:~T|s'>Swk 6,F.@gA cboEoa/5@;1FG`b|u{?:LվH NC<~·{`ǻLwV=)-Pwn+uyorַ͓z{XT1uq-k.}`gIƇ\{9w>evɶf ?$?>ׂT$yu.R":ܺz-g/#|}8L<S?uI/{}"q*J6}{PTe]f!̏v]' DpȌZ?.o:\ug#v༞?lV?^V}e b3=`k39~ßn%_ʻӃlo?O/Bauv;~C^~1赒5Oj+"8y}GiӃ=.?|]c#I#a^V)WE^3/'MvK+<_p(.z&D~95)D~SN?`erAB"]{rk-.#p6uL?s:BV<]|F{?&.[k^OΕu f9q/h ʆwfb^ǓOT~3UGJc~ py-:O7;Xhc˗8>[Y?:nƟwAqQxl'䄹F&Lς/iF؛ ~dİ.G=[^ɯ_U}n"zy!߫ g N]]zp7>baOkuѳ5.oCUo4q3'!u{-o;4¯S4q*0TkcꞳa?o/`}q<[R!)@<ܛ}n|VƵ37ՓJ*Z2\ښ㗩ڮ08 ~^Ր]x9ߒ$+Q]֎=r4đOnl?ߝ#md@Oc={:pTH4L[ 7GS}rD&;-joOg`?гkѧn+}z q%if3`ơ˰R ]q>e 8ڲq'~y<5KKnC3-Ҧ~?:x{Z.'ӓ?q9}s`kf:ȤyM_vq}۞e·_365p}Ǘd&Ww ?G:sRK~vbx0I{%O:)`5;oD>˵B&e6!GJi_93Ξ=:baoD?LbbQ;<`e8Ig7C='y+W_׋_:37k{K9FD1|߀uteV]QmnE3c_Ob!t>/EsHꦘl?ܠQ_UA/Eևߨ<~W>:y,H[{ҩou׻h彡tpc4.9$ zr@Iv]>u/[7(Ua_}a TRoFx1_.bŁ+m5z塧QOUl{==acK^#OV4aX8\bã56[@=| WyŸZ}ɳ$ܐ93t_bbA{!/lX7{O;ƧV{{F^Qq-\uRS \S=-Ěǭe#O۟ߘqhzfϵ9 n+Vd=Ӥe1޹Cl]%KeGQ-C"¿}_/O Bt+xaգOG]D?]h,C;3_9ΐ_mID|Q#>Z:bp}x"u ysVMR>,8ɵ[Aji(>xP82Y'l+/[7G_y;b2ן g:h Sr>"9Rꍇx&Yn §݋olg/%2nD^E죺v3o:1g8w?-? P٧'m7!2&@/Rw=}#Qv/ϗG 9+;M7ڜNīX$v_{ߚǨ3rub,r*orB'7]q#l(eig9磳mC%\6&֙Υ)+:P=;h4s^F3Nuxo$ޟi~2_}ݷul]u7|5>κocXD'ߞ*鬨gWMiA]/[c͞KE8+]q u^5nH!۞sMbVi߂ϯx觱*0~)zIiܪm_.; Juټhžȫ÷̽i1kɕC~w.>*C>{aeԉYB*#u0~gڪsJJ]`> LlzvSx̛qr1f> /WVjn@]7ۜЫ7 +]2W·+[ y|Q2~*ISs}[&BdjVƋ (;Q^Yyܘ_G^"֧e\Cߨ/k;rxܠjIЯgYt:Dĵyo]Y?g8 :+=6!}<_r=Oc]; aB~0NbYiEh`y>8dk!J|x|Q:yUsهgh.E?7A~,^}YY~3p(_g|,##'N;`qs4GXR1=yB'D΃-/*z&oÞ&&ˠދj+CMcpcy{.Ca'E }wzl󂣮ɨ J8sfOE~o|+Ec}2'_&c6V)(j݆r=O_/}3 j? M'غ}bi:IΌc_깠NJP d~er[c=_T~B^\ r ][?b\Py,3Aljq~гyJبNs)'8k+eEyEV/:sw/YϽܟ=\~~66<8vQU8 i?hS:OzDuHi#_u>h-;4^ Q{ViaswxP/"|+YigUn'CQUn7f+?Z^59*&=/?KX.yȭlQHzĒEJԯB]Nhcڳ>7{n`9˅?BDZܘcb+ GUidJ`<p!ޤxl=$']bvo`:{,u{=8`/G^50 ezNFjr(] ePv~Ø-a< ȿw8mbФzb0jJGS;ש\.#nbzk⌍Ɠ'eƪ`"O+?D|K+iAf++L *@Q+4߇},;qqu~sK' d8#t!o癆OF~{{=hXO4/!>[ute07~s_FSIE|OZ&c?e%y9hB{CelI6G 9iiVzzZFBuCGF| $O9\9=1~޿|al NhDz9{,>܏#ǩGB22n| V=#py$[w!vbxCQ$<5|9wvp pԛ{`OŰG|k󹫻)vKs!{uԇ]A?b0)l֛ؕC^_}Iϥ|\܃~<2|\W g$Oykb>EqQgstqfEg]UBhmyǒn#wF yd!{]yf'/\[Qߓczkxds{(?]̫}  nl=ѕuDFAy}EcÎ^Gyfh5s%׏KbFU|{- /b^D*-| 2PI5[`e9Z:jЗȐwߥŧ:'c*d`w&DXl^H\CY 'Ez퟽h:$&Ztg덺aw]:/)֩;,=n7]IكЯt0Q^W1{݀; Gaw61:?B'WyĨ&%#v팦{?8Ϲ^5%/ 5JE_"?{ q}).˛f@? :V^tjv? xQ ĺ(α*v وZK,y`^ؓMw2koVbYIg}^A< ݼvÍZQ: 9ߞLW}MZw?d %s$l?Ҝl?m/AeLz\qk=,%oD7=[tEu6滹!h/kp{$|VTk7ws޼|Iet@F!{ӄkW[}=b|4u0`ԔS _)wQ8Qh!['劋4ɥs:ۿ//^zӿn=3K޷ }%|):rD^y?" .6f},ߌi MA< }D>0S̿ka!؝`˭_3;8[<2[h˲cS6Mf{^S1z>9~VصU1ڸUJ C_Kx=-|h6-{|Jbɽs/~*6OᯣL;\ż%x:i/J/aCrK }: lüHs@rg6>k=yk2C[kw.}PqD$i53Iΐ~ۿ`7 ֵ>.&&Mk8Wc\(X }m!{O?+0~֝mޑ]E&v=ү~TYwa%q`ԕGгzaj'߭9je m=!nȟ6h"M$E׋Iw'X||cK ~z/MV9] l=\I/]7EX_ٯd0RzJZ^jqѥ\W:* K!̊Q]jxG\9k$.ŝ9 ~P7SAn`">coq4A dzzבwdv_)C'FI|r&]s8~@}$GwȾKls|=?Sz1*"M-sT^x֔F\*5;ODԭyvqvVYy3UxLd'Alдw-;gDr^/e[N-m9 ;)?z5<5@BdmB)/XjǟvQv0!*Z' EfQؽˢK5ځ5O0>n^ st/A2] 2 ^w!#;1^K*"B$uYC;_B"lLC4':%nǥZ]6q^o#f>n? P$Gġw9*YVȻ8ݍ '&~xݥ_q^^E[vfvѤ[W{9Yi>ڟǵzZN7 v29XrH[GR{u N8_]8,Gu:{^j씱>^a*U3ofkd4 uyc]0Q?|&spީCKDVUNM?f+ts/L1Acs9Ki `G{S>-9!ξ-C¾[|%#vO68gr:*w zwEAq9U!V/]Ұ aO θ38u7 euжh"ox)jKۺï )qقyVt^9)[y2qox\Wf;V#Y\TeOZ5aC7pP=Aal.~bnc([,v$zROS+ 0jJbv>*l?-*ЏO~7[ :6ծRyEl{sSօ~]x+q'쾰-ȫ ݭAo](fxr3}-l=jaɈ# o[m8;玲]|S(_=yTy aDx8{7v=} E}#ϱFsze.& ?~ n%ug0}>H^*DG&>'jxP5d? ioH\җ1);S{P/Z|Y {8wK) `/6eeFN^;&#=- o5$/čimK7;2v7wY!ƎJS5?CU!^Ů& -N_U9u 7Vb[gsn*o%op{l7 wsw݈]-kpj`;;y4b'K<O hz>c{.R.xięH)Y+DpT Wm{~cGqj\=*_*f }:dץ~Q1ǿ)cE/ 쇾Xjd}b́˹ 3Ǟ^ sy5vx_n6.m*] {~'`Fz /pOܗ_'r7~] mwl9~N/opF\?f l…~ ݴdۏbY)5Ǿ݆ 1>Mwo1~)۟EZr &Cs+ԡ' 5FR\9P~+J ]k_c}>+]-s]wtĄG-w7lqvS rW¾x%߷<œK%'s ߍ1bSw\Uk+<>P Xgs #㓤/k8SCGWU=s{nPw\-+9l- ㍠wFG\r?A<{N)=E+uJUҗL$mmڸ=j}&Y_\>(m/UG?e%~㭳z-.~,RtܵY=x \J|`Q+/~㏸EV h may12%-ȓz:G9g~7ȉ"O2 z7'|}YU?Jn_ `yyU^4g ӡ@Mӳo?T^z6ܐ"uʇ2ΏzV]:?SLA^3*\kshCȓnAo X~gvU3C%W%b<;,^ ˖&W9'=`ϓ yY8jY.` -A}1!TIqЯd}{rl,0oIy&^o:1}|ۣ{'G<ۆ818襮>|SV/9.Iٿ`6NvcNX!75+yz?nV4|:~ v-fܼo:_v/ټHC~KlO7|j ɔulYX);ΖPٹzפԿeK%3 ]| lJiS_or]?Z}ҴK}"60զaSk|zun_l{Q?k> 5@,c0^;M%ho+J/I^Ms^*=/o_mq|Uc㧉eф}P@^_:Re}lΊ<~rlbzY/|cJe5v$[p!1G_hV0k/U F\ yCyߑ.Q󦡆Q8E1>EΙ$n:ځ<#es\34ǥRțwH c<~h票8'C=VoqIT郼a苄WgƻeMXD_~3sOTd[V^gf=G \ww*oDQ@><̼ W{-&װ"{lԁ9WؒըEw!o)h~Fy B~+Gd%'gawy1tjp{2>8dF틷au@[i)Xܒ8NB֏R([WkZ֏|!ݤK)l_'so~UI\t(n%{h/_Uwa!p6Hқ5GY??-furF)] :3\,,ޗv=,2:D zgGߕ0*.yKC*"ew_F˝sׅ]9(yl^܇qWw<,)ol_7ςY)CL8o ,(/>Ŭ*еyb˰gQ+mӨQjpoٚf?A};7 yAs7rG5>w?_j6}}YY1Fsg1zh4*Nt*n(V&R?kחmbQyN8׺X E%ANn<|PnK<g4q9:Fk7۴q_`F Vm]k_vNQ_4Ý$[E,չ>QO<>e^Ix H">W:ʄu: F_o$_Fx5_s$_HxOF|MoNoXCr [ۊo&ڄMzfLf]$EaķK|+m l{vķBri-w9Q$w>Ał& =Ms/ GrO}  HB8Hp?d u!~LGy<vE^7 o$?pn§ OgL &5M6 H2pKs!??篓e—<_Hʼn Jn=A6K_'y[/M|a%;JZCg']Jn7{ĿNOH>G+-? %3?BDc l"j'_$$s[SDHq# *%g}Bw^/ ?kfh''v΅p aq<<}Ŭ FxQ⋛ Cxx5?e$CxQ?:c|"I=@z2ğJ|$6SpϨ':³ ?g3WHג%%/^Hxh8M|-uv#{zGU? f=|#~&Kx} 2AX'`oAmm$7%;aSi¦-7s"[H8N҂VCou6 n!lv{oo@rՄ>v&sa®js}BGrHžs {v+3I;~H|s$aM0⟬'~Oo#|jD3?H~ps!aߒK/hiɯ(rp_S 5Z _&|c2o\$~ɅM)wpLNNcw%}$_N:!Q ׄR۟Q#]?MnDg:p[@=pG>N½npWE;?O M2}R} [L D?,4◉7 /)Ax${~` +~`,{KOXMx{L~@f)an“+~@E~@i#@ճ />` h%^R E9Y턵,С~@W^5/,XM}aC `/,0CxCl`ɷPX`D}`V 6~Fx;&ݦA_ ,+&l-Cؚ l+E8 # ;m#D}` nk{nݩ+t_ c( Bi%J}_A}aILp$}DQWp`±QWG}_AO‰+H 'B}+8O}_>—J_^C˟kY[n&~[*S_Xоp= /,A?ܦw K/,x@}a#q~L}a P_X S_X‚. ^~+ ^S_X‚7O M ‚wc(O3_/,*Cy aMJCC}^_ RW |F4BieI-iS[8h2Ѹ ]$` &'͇PCh^Cv_E(~Ci~Cm?aiބw8͟p`K %/A(GJnK %ͳpTG< G%o"⏡BtGq\'} x MOBd:4p*''>"$|ːe:?/eeI7?K8rWB9_}%:474wO#N& !Ht_B8s g ,[:Y#?ۚ_[ݿ9DtCȡ+ k?ϐxJBSW^O: O?4/S ~/S~<O/SKT$|=~?:p|^|{R=5>OE/S__^Gn¯T+UT,>^P|B~ >z >Co*B* P_M,%M>~m'0|cU̯<^QŚ;ůk__Oߨ֟owTf7?_\#|>~!>^RŻ'*C-5[q[-DKKT۝p۷ᶗv8vkNMS^G"||OBGK>U{?6>+>9T T\?Ho)SSB)WGSՑ`zUJ4 fOçwU *8=:a@ 7TI}Sk{1 WegRYz]58|V1`S|6M.<$?7>'s5>^X.ե%_lYW6%xՊ|Wx1,FϬL|}ʛϣwVN>'z:: zi_ O?n'f2 ^mzkuZفC"w ߳ߧV7s> 'q]rU؅¥|Nag,E E\ܟq_1z]%eW_2 _r */WiWL2W|!o՛}7[|n'˝eKɯW/lqO^tΣJ/HUSN@^/=x;]5H5HZ Do!z ׿@ L _݁YzFz~i!17nC}6<Clkyw ;wߟ=g"n? ~R|Nx["bonD[!rogeW"-K<~;ޔ~xFxixG'x?pǏ`"#龜wr;࿮wf"٫(v+2zwGŏqن˞EƖ]صK<ޅ}|'lO`"'_'I+ɟtw>FX᧰)e/#nw[wSxwv4~F<j˟^Y<6րt~co cw#3jg3̏+FHv|;=?n&?4 Tf#!!y$)~kCzEw~$t>|w Z Em ɒZa߳fpvD_ʞH"჏8_f_~$r #ɊCE~QQ:$z >D`$F~pppk'ɚdFZJ3rccb?Ų_pd]O:L6nC܆܆|FM%I4&Nߎfs $!=l oa%[ϒOok^J{ᷳ;OoߙߥߕͮJWI>|;+7{G}Jo'%ÒqNWr+gIJ?| ;-Iy?^K"r>^Ie%GosIZ8>]#?_I_OWO!\ v_rM) ,$1>}dƟa'&X2rO,gY$0;297=Oy%ݱdW/39$ vg;\%d =\_yg,24/1˯ݚx~M^ر|;gY -׹Wq-7Lɿ=s-<ŽܚݴNZc?''s/-tyM˃dCvu=}Goy];iKm E%{>yy_®OJK__=Ǘ^2× |?y' w)-Rހ^dG$%{rڨ\kjx]vn){C}~rw_k=NWgG G V Ke]eճ _Bn<%ސ;vPc7dϨ5oĮQkܒܹkMwך7e5=7bMԚ 9wZs|s/EjƓ#5-Ij-ǓߒyG|+V{Oj&(5x+͸fkm۲ne7\s5 E=Lo>S{}Cgr;puݾ1 ߉IV95V:Η]ֵ[ϻz{p߯Ys߯Yyj\oZC|Ά}w7Hrs߯/|I- Kʯ>7heoeUO}g 3Ü\ oπ /O+'Ui P}s{pp0rqs:gGmm:;;3yxv/U>e,]Mccw#tNw|ѩw Ln@3ܧyW*䚦vfPortfolio/data/SWX.rda0000644000176200001440000011451414254636366014504 0ustar liggesuserswSE{{,X#v{II6ɦn *XP`{.bWPT슊ذwww{~z3g枻|2s'ҠAbegAV1hQaoRKgР9w=@m]@kkD io6k:g ޔ7V@? ?>~m6 _/7sϮ_`٭}sX <G{M ]7/uo]i߾Ӎ}O~ϗ B,9y÷_` | to؅#8|?^zNa _`tYG8~{nNkm=[Tt vmo@^"m]xnza!js|~v}  =GBؕ3A۝ݓ~{09NF.#~nB>z:H$'g:=ƏZGcx/cE̎mu zg}6omdh8qX{*[osr.E/dxn~;w‡z:/O./Ak/g }oi]/o[1?e3!]gխ!q~[|~ؼ6ݷ`#kи+o% :5_F⧇[̳l*yNo-]a< {uk8dkݷ5~}~}~^=?b&gcoj[2tZ_~[ko%za1>~U볭 qv79y Gx֚]}xYگXٕ8NٷRzZkW^6'~hi=ձ5%.tiʵo=XqG|Iގa'AzycgYKWxGGx3qG\xG%NG|?g=2ʛ3~u5 {|#w|"n#B^@7gec;Xv]imD_k߿ٹ|yW|=ȧ-O3hᬵ-05<߭b?>0wdguǪ9gk-Λ=Gt]{淪W{)mӏO_S=7>߈CC=uOo gᗽg~Z|)K#/g?x7G}#ί3C7Go hd\WxNyح7uμ؟{඿<-vc/>q?|p_Vsൿ?ڞ׸zyOKrw =؟O}'.|L>Oħ-ui?΀^ޟ}?'CkoR>SwW~{1W5wt`]\[{}{{[>{:f}>qOw||>uQߋuN;ȱP}n<>Y7>uiƩnonօsn=P/S#qoB}?G2/~ɕ}'{N_w }_a "{NC /Og~ߧp:3 g;N/E9>56Ici_>yWͿPpזבsķŽɃ'yԱܸԧMS=7z]h\z_wU\f'?|'_Z+>/[1.yÝϾO^Sqvl~O7y:6#Fh'/هǚ_ek:<֒7y / ߸D^Dou2ca/!1\2Z,7]> ,V`˿_ >nrVq6(9N?SX^^ݚO3+Mg& Y6VkXl߹v#Cs:.|޳jz`6~pv_?wmy/}%_'r-Ϲ'_^|PAկn_GcG]}u]&w?W997ı{Uva47yY?iٟc1>Z:yY=kxidU -|k-d-z彖iX>l~6XƳgKw6U,2P]ol?CZ`~1o/Emoxc۸۵b&w?TǓZ=a|5=k7:"?k/t+-ߵ|.eZ~du0ˇ-o矐WX L3>-xvVk =Izg\Z;d<u/ԇu$w \=\kXoY_rhn_ FG|W=b6k`|ɝ09_ܸzG⑏x&';q33wnZo'oxwP}N}׏})wĝ7qv/f'Vv]]ӝ_0vm߹6՛BǾM4Z݈#Nq$OWcbtعA ݶXչnB O|vpꈶ?`uA;>XꔆVOVO4|?~8i&W MȣZ}%.s8s+n| Q/p8n8sCz2wv{v3;sWl\i=kcxᛍkxZ}Cር'Vo9[Y?fQqB yGatYkI]s;lԬsiTk1B\Ǻ/^A߽oǞn]n:% ~<1|@A&P8@_>vXGylz[ 1mlC{*O7 ~uom@ (/Xm-> hqo@1Jɻ|}ڿ]^AZ-_kkHڿK|4X_ AX[|)?v z@(\]dky,p|󳚷]@ d}O姙c2P t*wl,:u |;_:eK:J/::ďɌ;AzQvJ:_I|Hvq?ψ/m2Yojݮ}]zN5{_8c·NegҞ|]_[O7ʰߺ߹=| T>|&yVfiΕħN;ד\~ K¿W@r7,zފ>,[qZҋʬ zE~2SzS^.TfV.fW>8;q3[ݾ/|uVʕqօƒpqe]p;VkL1{4(SW>WEwI/*ߊO37Iv]!^hsڶp2X~~#х/,w̔wP4{H:.u\Ӻ:ǿ_#N؍k2}z5⍽$ңe UT7&]O$Z mI--}( |d+'tĕ9|8zyF7qZOݲǴ_- ;/}}$f1е}o)*,?XzCt/R4M_Pai/_P*^cնWmIZUvjLzٲZF˞ZInImK>۾y04^mjmWjDg>݋϶Ez[Q~XJߊħb8A~xx_F\MvQx8G|/>(/Nݥ=я=g%G_|Kx1~=wRXomiYXWſ%$Ѕ]nF)>+!,zZdŅ¯V~V\YPqFc>DŔx\ >[?|J὿ЫXe"x/t]=.)~)*~)+m#;,'K¿XW J{),i<'~.MJo~r4Ui4yLq^%i< X޼6JAGMԨ 7~U\Yx]Qr-}?IYs[=M8)QUc0Rǵ祟Y߿ WggnɽDݩ= MҏR }ъcK{c߀.JÄ;E7'j=^EUQ7l; qu$zv3v3a=o&p]ėq=t$O4/WMdžEIһS\4'i첉}K6} lD o=Kjl5ݒgW?h8Mz0}~ycjȫ8M+KKߴL%x C=!q~^/ F2umjgӴ_ _Rj:iaӴӖbySwْӴM$m4npbw57U!6GKÅ ge?¿g pmp](>5Dݖҏ#4OH ko{3ySWCbK; m/_Į~'8em8ܴ'v4xutd)Kx }!{lĸޖ45΄/?Mgaipmst݋߻$O4Bi EGӍ㦏+ &?ټ y }?"_CC6' ϟ-k-NJO͟@KXvֲ\!]Gr?rK.̵iy*iiuc,F˞҇ VϦʿ7~^z|ײ3Cn~A5G\xqAk{i:\+;l.>! S>ycsEoxZe-G˭srżsė5ď#8-XGғp}\`[Vt ߭ ‰{EO57qįzowWeܿdSGS7B=ޛL')E;HuԍF(myz-ׅmvq)`DT|r(]9UWD`‡ɪ''moV=x+rjoQ{ha%},Πu'xaV{ɬw]g -d[{$9BRQǜUVԯy}c^zPq2uqo9=n>~\::NJ5=< 9_\'CY@T ~s^lMlMYqvQ\Um ~4/Β}q!U8v&x2Gi{ zgCۯͦԷEߠ.;u}-KIO[_ғEw\ߺXoLvضuos/纖bsA˪҃E,O;U@m蟍\OoKکS-C]. vŕdm_hoa"ra{xu׶; Q:_7߭mїyCnFno;=t`,!8MYbpf(8!/_9?V\ ?-m]/[͘xI1.E4:Ç:K.ak/~/T|^:ؗ1\OmNbz띤}&p Y-" 83 \W"g|.b_'Iie[iS_ڄV+L`tCJ؉}tP:HPb4B\ REttuy*ukd>P'(MHۣN;C=|,d-q`@]?Τ%N.NZ߬xHvW.!mb2O~# ++q.t|}`)סo6^)<-]<D^7'+,}(~/ž*^zԾi[j|eS[G>R?s82}eoWqZ 9ǹiN ={㴮KA}GF[{?WrSZwk Gr8Q~Fx[s)*SyUq\yL /rޑ}_ʏHʏ|Q~~OHN噬UD8R* _ riCzӱ_;\l~#opf_ߜ(+A1AUK>_3n3q>$%긓>|ӎǎ)GǁO0NmKG,;J?;+k=9\HT9,iDWLɯr?K~ J I(Ttuq;q^+Λ"\P[(Lq>TŹ9Zu=~'>w/\|fW%mO7 ߥMZiř_)R_BW}|E|\,w-~w <%>V^Qފ:5M#8㗱.kBׁ[]iޮcc]'Kn]GkޮSWDqJ}ss۴ wo.{׻ZGF}O^'v!~]]t}G}}}?C~*gtߊ])=Ꞧt?/^ks?^XNXFz.t1Ǻ?g?S=;c !l$ˌ7cՌ şo31Mx3ƻB0Sx3c_.zy>ү$ZsgWzs'|'-=9]/z.z̻℞=:t~'>̑yO+iWIc}Wx{쮷$96K?zoߙy⃙0sGS3G 3_ߛ9Q5^SZxgxNY`oul)=,+=]Y8ѻ]VqA^sCuy{9G ZYyj7o:Y.?g/:Kv;k}'ӬZ׬'Ek_j΢.9k2k:l|q'k/ZsܭWR;Վ|=TnRG/XF_/]Tf@GG6l^a>}NǞ~Ɤ>׷7qQ 5z b[u+2T6}8::o3^ [㋁TtRH-|Msv}5O껿ǑOOo=c{sw Ԯy.F@j OjHP IϊəC"śɇOHZn#6$e]/0_"LJp}+$o$oJ yj-W53>XNNJwC}xb yCy^ yz$9o|zOH 2Oe7SGw~t@^H>%|Ma~lř~@Կ5ɖ>iwwq*+$K]$w@IeoH䷒[1}_ɽ~@ 9Hnٷ̗$7/.g\ 4-Oֈ@_~OI~SYWrwSɼǵ 1@|乲)GO^yP _ߦ_6 $73#gwAa]kFk{g"G+Njk>j?xoiO w-ge/ k_WjgÒk|Ivk jC~Bm,vf?Hn4^oCYo8_4ѧwN y$zv@~_7ѷ:73Ω&D_{ ɹ?A_$gag]G=zIamI\|Mb'ơ  ^Nݝ8cYyj$_- z5(ze='0}p|Ծd=Ǔ>O:<\:py2,^zv@GE_d]ڰ.[=4ώi'>v WYp2c in},L/'c:xSr".Ž'^}l3y &%u\_V7_He үԊV}lz_ p%B{ReS)Ya*)|K"~RAWj\#)~+g ԩTBvʉ/qTq@oj_sdNkjG-שoe'ߢϵhɷ{OѿW[ >|]Ox w{^^^_T<\"O~}.uK[ ꋊ?/CxGڿ5_jkG텞B|/0qDUq*@_g]H_O['p/'qԮkOD(~f=H?R#mGu?.g~PZE}V淪B~-|J\+[K/+i}߱4NjcwjK^v%=n ?y81EحԱȷ}(?#MZ8ʠWtj,Ez%?:q?\rH {Ix'u(?F S{o{BqW]$̷ z6Tڔ~[m}~#U<Bekƕup)ai/R#rjUojSW^6JqN%E_s3}IS[cW amwofE|{pBd*_Ri%A~=ӿ8w"3`*Hm6$~[nMoRڇk~#'p;8#zo[@ u~FQbstkŽz: }S\rя0P+!k vG~/woR F*:?EG,$z؍|mDOzՅ<t>-bwοUwב^ZK/#Io'KO)nMޥ=u<tHyo:J1?Mü;飥(=JM'G#į4IΧco:-Me7o#?/{I'?WƮq-G CdOi+!S_cǤi,]|' ugHOӧA?]:FbU*;Kw/W ғTI";INOOO1Mzt-Di\"t\xɟcu`](}XXÑ(1#W'O/J&;OOM @~7bw3_/nGoY;88|z[x~x2z vp8-z/yp6}vrr/?uOTX{w94>Mx\2}ttn{_7zՎ7 ȟ`?7B%<\y̿W7!k_t뜍Eާ_GcOsnqz| ;C'fek$ »̦{f_e&(gbL9Zz->eL#+3[yO~?8ZyOzF|-,3A߷//',?,6|ս2oKwgddݯI3O32J^INo mDUlY2c%s]#u7 3St_Nfz.>ko?籾dWdߙSOp:S=fG2s\yY9S=^=tK FA.%~v}őYfwUw~]K}*3'n3ԡ2e7eBK y*ʴ1o\}D{r~NR.E.2U&^e]O\FsL}kD_[̓qu1Oy =x&E];v KeWNe3fWCkBOhf.|[(?y>f*>μ ߞf= ~NC~}!?]);n/)RʎVM˞ !˞zOF/DI왴1u 3{Yv1{/ׁ29y/ܣ2;MW~6DN/-e?,;G}df_7X?'Ⱦ7"|xW8핾d{٧gdٹҏ G_JOrQ>[Nu,u3|64_?NzƋsE {n:7^*ɱoN].yv9#CZ}7..΁q%q`6=GkseōV[ Gsҿic :A.$ rLӗ#~υ0;?%«\툾Η?dguOrrrHs[!9~>R\ ai|7ǾrB?vUޓM짺}XNN'ͮ߃]*o>\v.ȾoY}s3/ g)^@Ϗ_׌cӲ?f^?~־+>gzç36YHMN77ײYү{i0wǗGW/3;yٿ'/fEƯow#~ ,%fͿ-?o;_?~d߱UU-"% gVgV¿ +?[San:3-涀 ܖ[kn[!/rC$ܖ_%w ]cn >? 82qR+s%Ea]#7\}u,~jV>U 4oݪN׭nMWOLqWnrseWsonr>sx}p8Vm([]Zngۺ}?u#dungp_P.|.'\;MzYW8>]uݮrõw_uHu?2.Pǡdٕk9_?YJ~<,<̳ϕ~׋i/^JSr%#'9{*ͼ?A/fyx)z8Aw:#9iE<7?zos<!ctq9% s49΃ nS~<|AO)^͇?{|Jjݱ=sx~x~# ֊?CуuЗM燣g(No]r %z'}I$}ߨ8&rY_~,Z *VP Q扗 IGBKN8`WӔpSgOE_˿¼˟97%9gUXJ* ߯kaEgaE[@΅ue߅ķ> ɭp )/L| ZW2ɯpחK΅SeIŲJsNN"1މߙ>͒{Doq;u8G1ҏdg w\97R<\yzEן Zs?IC=%|o?>`܅?)/[:f}՘Ƭ#>,Ѯ-=1CcW|2f-R߲1GwB^g5u=ySv21k{1H+w:{֗i~[v;u^_<^2cf~綿,w)u->y2p{M9/}wG:O.{wٍBrK>}^k^{xk\9>k>?:~A3._-C>蹍L`|;㋵EGϏ#-ziύo x)ϭ^=zziVa>N?x&ozJ]oA+U3t|>ڵϭ65$G.ߵ/{3ܷq@$o߃~C}oݟs>g{F2]!9K>轕oc9ׂ/>8ᗹ?u? ;X Cz6㟁\rX'Fzy;dz穬#MwW=}9=sqC1ySv<s9g|ۿ~0Y=m:y&wB 3y83ߗB{Rgok#Jkك;^El'3߻S73}~kmfww!G~OʿnzZ쪋fGKUXٙI;7w ? povaz1uY{BNl:Ogq r?[\ m~G{kby}rzn8:s6}>q -_P1c|Mꛟ>q&rn-O;_7>ݧn:=%nvL|뗐*ܼy[O~3~>AOW柂ڽgg>A#c',a~ -~5}G@rq wم=;r1|-م6a]~s-?{,x؍y_4ly)^ĉ<=#~r܃cUyw.$qTo @nP޷x h7fautn ]Vٯ?l,7>p.]-/Y?m~{o0`|_~1mN^&M:˷GG w-2=4mzl|5}49Q{>=a~pw묵53~_>G a?A= |7[\9C ,C5-3a1.ͮc+n㜠#Q?qz,Sfџ8#uu2^>=G>G{7 >8ĽyxW?~E㇉ia;!7αgL| Y;o<##=kdD͌qGj_gp}t:/ |#.[| .{7{8=>S\n#NrZG< 5I0u0CYc O~λ_o&bx;\Pu~5aHkuKݮ?J({n VyMn},N]?eo\n4[}+,ﰸ W]FqsNN:߰7W`=A1^gO!%7>'ZzA7qr,_kӣ/@Ϻ9.捐ǹhz!osaZw:Edmޣw||M^죹늀_FouK\6B!OwS8"<O0B!`o!pyF|'2?#o&ܺq?D,G ##"3D"k##趖2B}*B\!r"ıC"ID#TzA#Gu)ytwZ{GFv~/DDDcwM<E?A:aEE((zEnQ\Q(ZOP!RwǢaGܼюNQ)J]-J}#ve$J[?-Q(`8'GWSQpϭ`r3#\wM<!"/B]4?GF#|o!މ<|D?L?S|ïEވ"H{!.s㳯eus{ԡ#[ez{~`ϩ[;y~# ws//gx+B:a)B=r"(]ZQfQ(kXž x"gSE9>eyKs Q:g׆~ؼ3F~iI]S7D'FQ((y(~{&(u(u3n ]Qn}U؟WK#^w?ũ qEQq7ySGű8P)=qp)N\7x@:DZ8u8Gk?qqpĵ={_V<'}ĩ8N;p8_q7N|NĝN>&/ u8~998;N*_qﱏ'^'>77/qGtqĉbԙy1-bKSuL$N08qq9qW1⋸wJ$bԍc8Np| 'u|1c7jY̜`?':$qrK|6N\sa&ןj|8wx3NqczDKџ80Jߑg&_/u:A}>A<@Ig4Aސ $g&ȿ 1%? q|}f{brz'wLp#A\W`?C#A(@q;a3 Ewmwuw+k%vI.wcw?<}I?;8_9w;'j|SW'?v +Aٝ[G~,y;GC=5}3qu'>St|Xԝ}Jq;;d߱Z1K>ž'_9{.ﾓ85ϻX\"_q~}Wی}9,?{vNT5}m\[}_f]``xNdo߁mJ?.|ҝ7#r9āka{ ?w f}W 8d{=w-r;~l>}ɍyvnx}gw|3%?tMwv}G\x/; >svd[׹[0ytZG]wi&5_Ï2.qM}?0v6'}0,L>wxߟnm00d0o<:ld/Lo}* 0`&S{$'.|w߿o/ "ӸsצO]xG"sD.ȺވE~}'HAe}WD|荄~{?z3-lu $~}h{{'W>cgzO+L=.L" a0u-Ļ#=0qo>B . a!o!0B1D,ľI81 !zDNA Q8"H/Ba<4D߂AɄB! q^!yy}{r g!qM:D" n%!y|{ Cر{ğ u O!)vI_| x$? msAЎևކ8WB@\uc!2D~φ;Cu9ιk{֍MR"{}w;Ε۾OjƤt֯SRIRx꾤$5%5'{7vG擤URQR}설SI߇KIIJ} 4ޒ?%5%%eW~A05)m#Vr?e$-釶5_~W>'HOTce1j>fs7w璲k|?lvgyE_Ǿ;U2[4%eОKg󥨿DD^O}aGv)銾W<}Z ӳew{~ӫ5nWNa:ou[>dCסp9X>egmwZ&=͙1ۖ]sw\_E7K4'塵07V{{j;9󹙿r[3'Lr?@|Z1=/KYh|ZgqG/]mק5{^(ӳ-3-.ƞŻȯoL7ū^sg(VÞOŮt,?o*;vY~G/?0,۟G~9yC牲,ǟyhcozdj5l~6?ݯ#֞槶yA|d[^Z{Pnwq&Gdőܪy^sso~xқ7u2}hFWFzHFf ~2#;pZ:|ީy*yZ_3soVHkLgyd7eXy?e~^2c25?vHwh]s҉^2d/4=πt숌Yϧy)RF>=#1#hO='هٱ@~ =tجSV{ ;(#]~˵NfvqyYwVᬞ_V0w@vLVUgj]Zoʯݒ|YY_Ye_jϪgg/߻R/'Ujj>ع}Y:U;goyskS {*;_#4;vj< )o:,o]# ; (^[~y,߂sV~Eo·J~ OOh~>̟oy{?YIwdO#?G{V滬Ѭ쨬t¬N2ggsޛ>!#='#],O;jߌg,?E8u<#!}|fNSzFFzAF]F7~Ѻ/Gŋdh?gNgN&H|(Z/}yEA=Oڗy,o4~lاhyr~~;'~糵ꇞBzOB | >j=-=QhUWPXs7h~<_.-=|ً9909(9=qN5/;snɎ->ρK!;үHv_Z ;߭~/rҿssG+9e~~>e4rG9/??.#wF1汜to?7n ?u%7[##s'9s9>5_yp9C?]cgsv>7dzoi=II^Iɏe'4NS܋xIgZS:}Nk\ԏ{Ok}svX#K~e\G߿~G_^Sg4Rq+~.Vt}O냿ovDm5>~ŅWo~^]͏g~Q~Nh=[S[~{goP<_]|j/j\6^~_itk{4<{H$>gIǰi~ ^Q{Rcc~o@~޳{do ~@aƊvYOɾw5N<ڿt?)^n_`|?p?~ǃk?Ϫ}V?\nw}dϻ~DVw3?_Zo=ղOf|lzs֟ycsxjGvAzf~@xvBJ|뢭I~p{?y[5N_x&?'7DgN5ol6 XO#{o~5ŧ(lXo0Bߡ+k֨}J[yt<>Mh?W.Nj~>ysh=Oy'C??'*);υX}?->3!?u__);;}_1IfIiS;7sdZ\~/{`_V,>B~Z?|v8 +-{o38-zelf{[{{w<.r,.E󨟟JI=?gvv>I΃]l]2YGv=sxT^IOI[sIC`/ǵq`<;iK?$8>u'N%HWH=j;Oh1~sHh}I(u?t?'^\k\5.7xuEL#bZbbzn1{?7 7.:ťe?SzC\p\:^+7P<`B3~ۯG3=y'qΉHseg$d/8O풐~t?of\ OBe?7'CB:c|S~g}۹$ 3U}y"ّ k~}v.Ήks,3!] ?fo[넟>)Ϯ_*!.~KTBq ov^-IOڗ;~Jv{Bv?N>+$4%dg%ws]COh8!6!)!{{ gKvXBNBvB6!sv>>mޒ_)SqX aZ| 3^ 1> $%4e kvNH?vlb`/{dz$쨄~#t歨ڨYTt[TiTۨ{TxT?u1,#;y IX':-&='*/xj~]ݨ濨cTǨƨQ̓QQQgFgFhhވjݍΈh|a3Q{FEw~.xhj("*"{1dD;6D4oE7FE#O֙tިy=쳨oT󨞋ϳDױվNj}O+Nx^ʮqjXyT Ϩ3h~S|PTzWLLLvJ?]6t11{1!1kn]4dĴ!{/▿F&,&=;)B\눷져'qُq]xqGqyX<⚗)?{WyZ5CUqB#U `zCdX^D='Ri{ \ߐ󯞣 G1nzMi/koj ߧ~dz{˻yxLgr|zlQ|KoZ;h&W/ql\k_)#lm2tJ%_Wj:ubs[}~f숄t粟9n#ͳVnt쮄 ŏh~Ɠ6:d~}KȞuS_7yYm1tfuu>ql~غfyq͟l~"oϯcj~;IRvV&);2u=vJT7ޘ^%i|H'>II_~.tK/THI3GvjRdR"S0kaX~ϗd~]šWv_*=Oyʟ,A[R)kvұ=ߓݯݤƋmX<{}.NcՕNy,U?S-~*&r}g ~<xYS٬ߕ>q?VXte_n,QgX\gڧBdo{=T|# )ԟR RLSהֽ͔壐~ݛV;e5=_靖G aJtJ~]VRZTZIZ휖Vܓ<]d8ֺIkKKOOky:z==N >@픖3*-YZ~ֹ@vTZ:oZ뉟>2vswHoyvk''=IZt~$RFAy9#}5# y)9#;7#;6#;Z<Ƒh$uZ3-={ғ-9иHg|#3fCZ~ِ_'#(y&-#yy-8)-1mqZ.{"Ev>^m\IK)$]뵟N}yY&%?'|*wٝ);)Ô쇔tfw.-<}^Z#6N#e7eUL9|iY)iZG_# -{>-;HWJKW߱߷J,//hg2d3>h]Ψ}Ɏȴ.6X^ ox ͣ8ݒ2y!=ܹϋ˾<'fՏ:O糥#g<3ܶ+*ʮjjW?߭y+eodduYGY<+?PVEV0^gV\V_wV]ϳ!&8ݬt@]vmVt.߷ֵY3~.I(.?*>kmG e}i?6qCw[q)DžBwBknϻ{KڽP*/Ct}͗>{{߽k?_}Ut[\?uP=U\ .ZKVqYoV y} ?~ߗn ;k(uBη99{/u ƚGrZgr_rZ=)sz>9gN~6~'`D#?JTgGp?vb2)2+qJpKh o_xƙeߪY KM=|5dO-Zǰ%}e?8vn? \ C ;6w|i: w)?-pn5wh{ >>}_ < ?~'ys~7ONySpv6 fP>2=Dž ޹97?Popk?] }?O{O} j߷_1 ge>@d!%9,:}XCo#z2|M˵|KpOfï~(ec?f*):\:: _kX>~#|׊k }Oyn?O ~}K_v&Ӷo8FW77~~By7ϸ~x3_ n]~gQ޶g?]~+s?'Sfpv.;w=(#p{{_=|A-X F#ǂ#/Hy 88߷$)O=N_NY ?ۃ\gp{p?+m r!zæڔ:<Ꮹ Z>7<,+OHS>)tF6ÿZ3[P>1x૯?TCʯyZh+|r%ӆ?})6 y-q S x ெYg(IR_? M߁,/;～}׀kcτ_k2xPyQWF?v/Jy#˂| ~2%)/?jK)x;ࣿ_S^ 6sW=~O(?n3?>_RkxWt1ZU)s4s[~{ \?op! {~.@y7_KyY-߇tN6omMm7P%pas*?g5)w*8 ]^M{OKpO^ (oOLhpO Ly<8\;~ < {>]C_ta #G^Lo?j6c_rw )O8 }Eq+,'v~@CJ.BJo_.Eʡo+W@*oGoK+? >};8};T \+vpvP};q6ƗзAMFjouз>};GT7X>m0ACѓMз&ASyop_go-з߂[ nFڠom |6vn&AzEsѷAGzpззAGp'v };8/poo}R^p;8AA };H'A_/vzΠo ƁGoѷG? Eoo#?};i7< K$|#RjI?v ~i1,~3,3~a٧/G{G<O/O_FXBH+hEx2a=+?w$< ~Ec;J *(vjKQqz ga-5A k*a_~?8Iע_&%_:ס߆'.6; ~]oxJe zQ_%SaR? Nذ7 ߐq^ lt/F{o'lr'7 iWMotfo_(l 3-Rek-&~O ~ߦ63 ſ ~[Lu៍)l7۽ۏ5 ;TTasKCw\; Uy.. {k_]0k# ~=~+W kS‰2"Wߊ6b o[Kx(k~4%i%/_Qm;:]}(wnAKFz_ve{}}oxfЗp'#-?h3΂~??9| WS?9o>]Õz_5?_:|gOϮ~pu9_iϗ|p8_ ᯽ῄ;\ :=_?/~W:eW񇇯~ ~pM7_7q%7o\ M࿉=|k:M oSâgނԆHXῃ>|gwLJ.~sE,,ۇ CGIQq ~  ~_k[gu Vۈ??_,/-7߾ ;΄xpǧ"n ٔw^n! ևT_~'EAk ]?V#qOéwEw3 Y½o'z_GCgc/?wwpO@G?o}o>ϗ ."_CaGߟO$o=Td %/"~"_JSK_NCeN_f 2o/KE\-刷ȗ(.叧_B5FH ~O? *m_?8|(W}~v?+y :wSX .'t_8|ͅk? ɟt=Zךgk/~Fu>2#S!)#$_~}K'ïOIש5Հߐ|Ñ?Xo4=qEo,&ĩ䛖ߔx|ӧ7#n%߼$7Oo(3J?#,oA\Ke-oɟ Ug{ɷ /6?8|v_?lg1v'N&~.;4*>n#w~GiD\My.uw#&]w}~7oݫR𻯅=.ߓ|">'k^_AKI;>q}9ByR} ~ ?r(q>1}%c?P#"o'ρߗx|%.(,ʧg-Oo!n(m ?KP>>BS?w9\=@|Q~g8@6PzCJR~0CG_T E% a~9ß?xRG8__7Q.?eߔKsʏ?_ ^o +Ï>rq㡮_.S_z\p;=aȸ)ncŹ 3np. q)~TW? ˎ3*_t]F& h2t8tFe )vĆR;:d!k8bȠ žVaAG.c9`t3n޺mm[uΪ=pJ㇌gsG]Z'zUXFhHpR!6nfPortfolio/man/0000755000176200001440000000000014421312310013137 5ustar liggesusersfPortfolio/man/portfolio-getDefault.Rd0000644000176200001440000000367614420254764017562 0ustar liggesusers\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.Rd0000644000176200001440000000113414254636366016477 0ustar liggesusers\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/nlminb2.Rd0000644000176200001440000000626514421036702015010 0ustar liggesusers\name{nlminb2} \alias{nlminb2} \title{Constrained nonlinear minimization} \description{ Solve constrained nonlinear minimization problem with nonlinear constraints using a penalty and barrier approach. } \usage{ nlminb2(start, objective, eqFun = NULL, leqFun = NULL, lower = -Inf, upper = Inf, gradient = NULL, hessian = NULL, control = list(), env = .GlobalEnv) } \arguments{ \item{start}{ a numeric vector, initial values for the parameters to be optimized.} \item{objective}{ function to be minimized. Must return a scalar value (possibly NA/Inf). The first argument to objective is the vector of parameters to be optimized, whose initial values are supplied through \code{start}. Further arguments (fixed during the course of the optimization) to objective may be specified as well. see \code{env}. } \item{eqFun}{ a list of functions describing equal constraints.} \item{leqFun}{ a list of functions describing less equal constraints.} \item{lower, upper}{ two vectors of lower and upper bounds, replicated to be as long as \code{start}. If unspecified, all parameters are assumed to be unconstrained.} \item{gradient}{ an optional function that takes the same arguments as \code{objective} and evaluates the gradient of \code{objective} at its first argument. Must return a vector as long as \code{start}.} \item{hessian}{ an optional function that takes the same arguments as \code{objective} and evaluates the hessian of \code{objective} at its first argument. Must return a square matrix of order \code{length(start)}. Only the lower triangle is used.} \item{control}{ a list of control parameters. See below for details.} \item{env}{ the environment in which objective, constraint, control functions are evaluated.} } \value{ A list with following elements: \item{par}{ a numeric vector, the best set of parameters found.} \item{objective}{ a numeric value, the value of \code{objective} corresponding to \code{par}.} \item{convergence}{ an integer code, 0 indicates successful convergence.} \item{message}{ a character string giving any additional information returned by the optimizer, or NULL. For details, see PORT documentation.} \item{iterations}{ am integer value, the number of iterations performed.} \item{evaluations}{ an integer value, the number of objective function and gradient function evaluations.} } \author{ For the R port of \code{nlminb} Douglas Bates and Deepayan Sarkar, for the R/Rmetrics port of \code{nlminb2} Diethelm Wuertz, for the PORT library netlib.bell-labs.com. } \references{ Paul A. Jensen & Jonathan F. Bard, Operations Research Models and Methods, 2001 Appendix A, Algorithms for Constrained Optimization, \url{https://www.me.utexas.edu/~jensen/ORMM/supplements/index.html}. PORT Library, \url{https://netlib.org/port/}. } \keyword{optimize} fPortfolio/man/backtest-plots.Rd0000644000176200001440000000717014254636366016422 0ustar liggesusers\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.Rd0000644000176200001440000000462014254636366017263 0ustar liggesusers\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.Rd0000644000176200001440000000773414254636366017112 0ustar liggesusers\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.Rd0000644000176200001440000000322214254636366017356 0ustar liggesusers\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.Rd0000644000176200001440000000642414254636366020156 0ustar liggesusers\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.Rd0000644000176200001440000002376614254636366016540 0ustar liggesusers\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.Rd0000644000176200001440000000075014254636366016261 0ustar liggesusers\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.Rd0000644000176200001440000000344214254636366016563 0ustar liggesusers\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.Rd0000644000176200001440000000342614254636366017263 0ustar liggesusers\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.Rd0000644000176200001440000000231514421312357016061 0ustar liggesusers\name{methods-plot} \alias{plot-methods} \alias{.fportfolio.plot.1} \alias{.fportfolio.plot.2} \alias{.fportfolio.plot.3} \alias{.fportfolio.plot.4} \alias{.fportfolio.plot.5} \alias{.fportfolio.plot.6} \alias{.fportfolio.plot.7} \alias{.fportfolio.plot.8} \title{plot-methods} \description{ Various plot-methods. In particalur, functions \code{.fportfolio.plot.[i]()} will: \enumerate{ \item plot the efficient frontier, \item add minimum risk portfolio, \item add tangency portfolio, \item add risk/return of single assets, \item add equal weights portfolio, \item add two asset frontiers [0-1 PF only], \item add Monte Carlo portfolios, and/or \item add Sharpe ratio [MV PF only]. } } \usage{ .fportfolio.plot.1(x) .fportfolio.plot.2(x) .fportfolio.plot.3(x) .fportfolio.plot.4(x) .fportfolio.plot.5(x) .fportfolio.plot.6(x) .fportfolio.plot.7(x) .fportfolio.plot.8(x) } \arguments{ \item{x}{an 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-performance.Rd0000644000176200001440000000165614254636366017565 0ustar liggesusers\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.Rd0000644000176200001440000000161614420254764017327 0ustar liggesusers\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{https://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.Rd0000644000176200001440000001345314254636366016230 0ustar liggesusers\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.Rd0000644000176200001440000000311114254636366017613 0ustar liggesusers\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.Rd0000644000176200001440000000565014254636366016575 0ustar liggesusers\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.Rd0000644000176200001440000000314614254636366017460 0ustar liggesusers\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.Rd0000644000176200001440000000677214254636366016741 0ustar liggesusers\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.Rd0000644000176200001440000000051314254636366016613 0ustar liggesusers\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.Rd0000644000176200001440000000303114254636366015714 0ustar liggesusers\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.Rd0000644000176200001440000000263114254636366020076 0ustar liggesusers\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.Rd0000644000176200001440000000077014254636366016103 0ustar liggesusers\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.Rd0000644000176200001440000000714714254636366016725 0ustar liggesusers\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.Rd0000644000176200001440000000445414254636366017572 0ustar liggesusers\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.Rd0000644000176200001440000000533114254636366020026 0ustar liggesusers\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.Rd0000644000176200001440000001062114254636366020146 0ustar liggesusers\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.Rd0000644000176200001440000001602714254636366016356 0ustar liggesusers\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.Rd0000644000176200001440000000721314254636366017102 0ustar liggesusers\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.Rd0000644000176200001440000000166714254636366016560 0ustar liggesusers\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.Rd0000644000176200001440000000152214254636366017612 0ustar liggesusers\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.Rd0000644000176200001440000000360314254636366020416 0ustar liggesusers\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.Rd0000644000176200001440000000631714254636366017461 0ustar liggesusers\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.Rd0000644000176200001440000000644114254636366015622 0ustar liggesusers\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.Rd0000644000176200001440000000505414254636366015614 0ustar liggesusers\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.Rd0000644000176200001440000000573314254636366017274 0ustar liggesusers\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.Rd0000644000176200001440000000224114254636366016712 0ustar liggesusers\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.Rd0000644000176200001440000001140414421027324015706 0ustar liggesusers\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}{...} %% donlp2 items: %% \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.Rd0000644000176200001440000003361214254636366020326 0ustar liggesusers\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.Rd0000644000176200001440000001415314254636366017616 0ustar liggesusers\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.Rd0000644000176200001440000000431014254636366017145 0ustar liggesusers\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.Rd0000644000176200001440000001322514421026314017761 0ustar liggesusers\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.Rd0000644000176200001440000000556514254636366020611 0ustar liggesusers\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.Rd0000644000176200001440000000401414254636366017041 0ustar liggesusers\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.Rd0000644000176200001440000000122514254636366016475 0ustar liggesusers\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.Rd0000644000176200001440000000112714421025577016676 0ustar liggesusers\name{risk-surfaceRisk} \alias{markowitzHull} \alias{feasibleGrid} \title{Surface Risk Analytics} \description{ Functions for surface risk analytics. } \usage{ markowitzHull(data, nFrontierPoints=50) feasibleGrid(hull, trace=FALSE) } \arguments{ \item{data}{data} \item{hull}{hull} \item{nFrontierPoints}{nFrontierPoints} \item{trace}{trace} } \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.Rd0000644000176200001440000000051314254636366016341 0ustar liggesusers\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.Rd0000644000176200001440000000724714421026162016601 0ustar liggesusers\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", "lpSolve")} a character %% REMOVED: "Rdonlp2" 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.Rd0000644000176200001440000000133514254636366017152 0ustar liggesusers\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.Rd0000644000176200001440000000655314254636366017110 0ustar liggesusers\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.Rd0000644000176200001440000000157314254636366015351 0ustar liggesusers\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/nlminb2Control.Rd0000644000176200001440000000344614421033130016337 0ustar liggesusers\name{nlminb2Control} \alias{nlminb2Control} \title{Control variables for Rnlminb2} \description{ Collection of Control Variables} \usage{ nlminb2Control(eval.max = 500, iter.max = 400, trace = 0, abs.tol = 1e-20, rel.tol = 1e-10, x.tol = 1.5e-8, step.min = 2.2e-14, scale = 1, R = 1.0, beta = 0.01, steps.max = 10, steps.tol = 1e-6) } \arguments{ \item{eval.max}{ an integer value. Maximum number of evaluations of the objective function allowed. Defaults to 500.} \item{iter.max}{ an integer value. Maximum number of iterations allowed. Defaults to 400.} \item{trace}{ an integer value. The value of the objective function and the parameters is printed every trace'th iteration. Defaults to 0 which indicates no trace information is to be printed.} \item{abs.tol}{ a numeric value. Absolute tolerance. Defaults to 1e-20.} \item{rel.tol}{ a numeric value. Relative tolerance. Defaults to 1e-10.} \item{x.tol}{ a numeric value. X tolerance. Defaults to 1.5e-8.} \item{step.min}{ a numeric value. Minimum step size. Defaults to 2.2e-14.} \item{scale}{ See PORT documentation (or leave alone).} \item{R}{ a numeric value. The multiplier and devisor for the barrier and penalty function terms. Defaults to 1.0} \item{beta}{ a numeric value. The value by which R is lowered in each iteration step. Defaults to 0.01.} \item{steps.max}{ an integer value. The maximum number of iteration steps in which the penalty and barrier terms are lowered. Defaults to 10.} \item{steps.tol}{ a numeric value. The penalty and barrier tolerance. Defaults to 1e-6.} } \keyword{optimize} fPortfolio/man/risk-budgeting.Rd0000644000176200001440000000225414254636366016377 0ustar liggesusers\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.Rd0000644000176200001440000000645114254636366017071 0ustar liggesusers\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.Rd0000644000176200001440000000347014421026236016416 0ustar liggesusers\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/DESCRIPTION0000644000176200001440000000231114421703056014102 0ustar liggesusersPackage: fPortfolio Title: Rmetrics - Portfolio Selection and Optimization Date: 2023-04-22 Version: 4023.84 Authors@R: c( person("Diethelm", "Wuertz", role = "aut"), person("Tobias", "Setz", role = "aut"), person("Yohan", "Chalabi", role = "aut"), person("William", "Chen", role = "ctb"), person("Stefan", "Theussl", role = c("aut", "cre"), email = "Stefan.Theussl@R-project.org") ) Description: 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: parma, Rsymphony, dplR, bcp, fGarch, mvoutlier Additional_repositories: https://r-forge.r-project.org/ LazyData: yes License: GPL (>= 2) URL: https://r-forge.r-project.org/projects/rmetrics/ NeedsCompilation: no Packaged: 2023-04-23 20:28:47 UTC; parallels Author: Diethelm Wuertz [aut], Tobias Setz [aut], Yohan Chalabi [aut], William Chen [ctb], Stefan Theussl [aut, cre] Maintainer: Stefan Theussl Repository: CRAN Date/Publication: 2023-04-25 07:50:06 UTC fPortfolio/R/0000755000176200001440000000000014421307766012610 5ustar liggesusersfPortfolio/R/utils-exampleData.R0000644000176200001440000001462114254636366016327 0ustar liggesusers # 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.R0000644000176200001440000001557114254636366015370 0ustar liggesusers # 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.R0000644000176200001440000001033114254636366016677 0ustar liggesusers # 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.R0000644000176200001440000001122514420254764020045 0ustar liggesusers # 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 (inherits(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.R0000644000176200001440000001026014254636366015747 0ustar liggesusers # 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.R0000644000176200001440000000357614254636366016111 0ustar liggesusers # 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.R0000644000176200001440000002575514420254764020214 0ustar liggesusers # 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 (inherits(data,"fPFOLIODATA")) { Data <- data data <- getSeries(data) } else if (inherits(data,"timeSeries")) { Data <- portfolioData(data, spec) } # Constraints: if (inherits(constraints,"fPFOLIOSPEC")) { Constraints <- constraints constraints <- Constraints@stringConstraints } else if (inherits(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.R0000644000176200001440000000324714254636366015547 0ustar liggesusers # 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.R0000644000176200001440000001574714254636366015033 0ustar liggesusers # 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.R0000644000176200001440000001242514254636366015750 0ustar liggesusers # 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.R0000644000176200001440000000255314254636366016545 0ustar liggesusers # 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.R0000644000176200001440000002245614254636366017622 0ustar liggesusers # 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.R0000644000176200001440000004645314421032714016060 0ustar liggesusers # 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(Rsolnp) # ### REMOVED ### require(Rnlminb2) # ### REMOVED ### require(Rdonlp2) # 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 <- fPortfolio::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.R0000644000176200001440000000226314254636366016054 0ustar liggesusers # 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.R0000644000176200001440000001373414254636366016364 0ustar liggesusers # 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.R0000644000176200001440000000577314254636366015571 0ustar liggesusers # 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.R0000644000176200001440000000501614254636366013577 0ustar liggesusers # 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.R0000644000176200001440000000544614254636366017053 0ustar liggesusers # 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.R0000644000176200001440000003034114254636366016031 0ustar liggesusers # 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.R0000644000176200001440000000415614254636366015765 0ustar liggesusers # 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.R0000644000176200001440000003252314254636366016214 0ustar liggesusers # 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.R0000644000176200001440000001617614421020652017024 0ustar liggesusers ################################################################################ # 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: "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", "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(inherits(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.R0000644000176200001440000001513214254636366015771 0ustar liggesusers # 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.R0000644000176200001440000002675314420254764020426 0ustar liggesusers ################################################################################ # 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 (inherits(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 (inherits(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 (inherits(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 (inherits(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.R0000644000176200001440000001650314254636366017577 0ustar liggesusers ################################################################################ # 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.R0000644000176200001440000001073614254636366015166 0ustar liggesusers # 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.R0000644000176200001440000001661714254636366017236 0ustar liggesusers # 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.R0000644000176200001440000005663714420254764020463 0ustar liggesusers ################################################################################ # 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 (inherits(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 (inherits(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 (inherits(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 (inherits(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 (inherits(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 (inherits(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.R0000644000176200001440000001455214254636366016500 0ustar liggesusers # 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.R0000644000176200001440000001160014254636366017104 0ustar liggesusers # 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.R0000644000176200001440000001634014254636366015473 0ustar liggesusers # 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.R0000644000176200001440000002213414254636366015143 0ustar liggesusers # 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.R0000644000176200001440000000206014254636366020155 0ustar liggesusers # 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.R0000644000176200001440000005327214254636366015667 0ustar liggesusers # 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.R0000644000176200001440000006403214254636366017632 0ustar liggesusers # 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.R0000644000176200001440000000533414254636366020327 0ustar liggesusers # 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.R0000644000176200001440000002327014254636366015616 0ustar liggesusers # 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.R0000644000176200001440000003464614254636366016376 0ustar liggesusers # 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.R0000644000176200001440000001217514254636366016212 0ustar liggesusers # 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.R0000644000176200001440000000223114254636366015760 0ustar liggesusers # 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.R0000644000176200001440000000441714421032042015112 0ustar liggesusers # 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() # ### REMOVED ### 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: ans <- rnlminb2NLP(start, objective, lower, upper, linCons) ans } ################################################################################ fPortfolio/R/risk-pfolioMeasures.R0000644000176200001440000002073614254636366016713 0ustar liggesusers # 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.R0000644000176200001440000000344414254636366016437 0ustar liggesusers # 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.R0000644000176200001440000002611614254636366017102 0ustar liggesusers # 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.R0000644000176200001440000000541514254636366015633 0ustar liggesusers # 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.R0000644000176200001440000000744614421021062015177 0ustar liggesusers # 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 . # nlminb2NLP . yes function x x yes yes . nlminb2NLPControl . # amplNLP . length character x x . . yes amplNLPControl yes # donlp2NLP removed yes function x x yes yes . donlp2NLPControl . # # 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.R0000644000176200001440000001531514254636366015350 0ustar liggesusers # 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.R0000644000176200001440000001210214254636366015572 0ustar liggesusers # 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.R0000644000176200001440000001107314420254764017671 0ustar liggesusers # 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(inherits(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 (inherits(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 (inherits(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.R0000644000176200001440000003524114421032074016455 0ustar liggesusers # 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 # nlminb2 Code imported from Rnlminb2 on R-Forge # rnlminb2 Synonym for 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 } ################################################################################ ## Description: ## NLMINB2 is an interior point nonlinear constrained programming ## problem interface written by Dietgelm Wuertz. The version here ## calls the R function nlminb from R's base environment. ## Author: ## Douglas Bates and Deepayan Sarkar have written the nlminb R Port. ## David M. Gay has written the underlying Fortran code. ## Diethelm Wuertz has added nonlinear constraints functionality nlminb2. ## To facilitate CRAN checking, Stefan Theussl integrated the code into ## fPortfolio. rnlminb2 <- function(...) { fPortfolio::nlminb2(...) } nlminb2 <- function( start, objective, eqFun = NULL, leqFun = NULL, lower = -Inf, upper = Inf, gradient = NULL, hessian = NULL, control = list(), env = .GlobalEnv) { # A function implemented by Diethelm Wuertz # Description: # Nonlinear programming with nonlinear constraints # Details: # min f(x) # # lower_i < x_i < upper_i # s/t h_i(x) = 0 # g_i(x) <= 0 # Arguments: # start - numeric vector of start values # objective - objective function to be minimized f(x) # eqFun - equal constraint functions h_i(x) = 0 # leqFun - less equal constraint functions g_i(x) <= 0 # lower, upper - lower and upper bounds # gradient - optional gradient of f(x) # hessian - optional hessian of f(x) # scale - control parameter # control - control list # eval.max - maximum number of evaluations (200) # iter.max - maximum number of iterations (150) # trace - value of the objective function and the parameters # is printed every trace'th iteration (0) # abs.tol - absolute tolerance (1e-20) # rel.tol - relative tolerance (1e-10) # x.tol - X tolerance (1.5e-8) # step.min - minimum step size (2.2e-14) # Todo: # R, N and alpha should become part of the control list. # FUNCTION: # Debug: DEBUG = FALSE # Control List: ctrl = nlminb2Control() if (length(control) > 0) for (name in names(control)) ctrl[name] = control[name] control = ctrl # Arg Functions: if (DEBUG) { print(eqFun) print(eqFun(start)) print(leqFun) print(leqFun(start)) } # Composed Objective Function: if (is.null(eqFun(start))) { type = "leq" fun <- function(x, r) { objective(x) - r * sum(.Log(-leqFun(x))) } } else if (is.null(leqFun(start))) { type = "eq" fun <- function(x, r) { objective(x) + sum((eqFun(x))^2 / r) } } else { type = "both" fun <- function(x, r) { objective(x) + sum((eqFun(x))^2 / r) - r * sum(.Log(-leqFun(x))) } } # Compute in global environment: fun2 = function(x, r) { return(as.double(eval(fun(x, r), env))) } # Debug: if (DEBUG) { print(fun) print(fun(start, 1)) } # Minimization: steps.tol <- control$steps.tol R <- control$R beta <- control$beta scale <- control$scale trace = control$trace if (trace > 0) TRACE = TRUE else TRACE = FALSE control2 = control control2[["R"]] <- NULL control2[["beta"]] <- NULL control2[["steps.max"]] <- NULL control2[["steps.tol"]] <- NULL control2[["scale"]] <- NULL counts <- 0 test <- 0 while (counts < control$steps.max && test == 0) { counts = counts + 1 ans = nlminb( start = start, objective = fun2, gradient = gradient, hessian = hessian, scale = scale, control = control2, lower = lower, upper = upper, r = R) start = ans$par tol = abs((fun(ans$par, R)-objective(ans$par))/objective(ans$par)) if (!is.na(tol)) if (tol < steps.tol) test = 1 if (TRACE) { print(paste("counts:", counts, "R:", R)) print(paste(" ", ans$convergence)) print(paste(" ", ans$message)) print(ans$par) print(fun(ans$par, R)) print(objective(ans$par)) print(tol) } R = beta * R } if (TRACE) { print(paste("type:", type)) cat("\n\n") } # Return Value: ans } # ------------------------------------------------------------------------------ .Log <- function(x) { # Description: # Returns log taking care of negative values # FUNCTION: # Check for negative values: x[x < 0] <- 0 # Return Value: log(x) } ################################################################################ nlminb2Control <- function( eval.max = 500, iter.max = 400, trace = 0, abs.tol = 1e-20, rel.tol = 1e-10, x.tol = 1.5e-8, step.min = 2.2e-14, scale = 1, R = 1, beta = 0.01, steps.max = 10, steps.tol = 1e-6) { # A function implemented by Diethelm Wuertz # Description: # Returns Control list # Arguments: # none # FUNCTION: # Control list: optim <- 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 = beta, steps.max = steps.max, steps.tol = steps.tol) # Return Value: optim } 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.R0000644000176200001440000002041514254636366017510 0ustar liggesusers # 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.R0000644000176200001440000004614614420254764016371 0ustar liggesusers ################################################################################ # 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.R0000644000176200001440000000664514254636366016555 0ustar liggesusers # 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.R0000644000176200001440000004256314254636366016167 0ustar liggesusers # 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.R0000644000176200001440000000246714254636366016015 0ustar liggesusers # 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.R0000644000176200001440000001030514254636366015021 0ustar liggesusers # 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.R0000644000176200001440000005271614420254764015643 0ustar liggesusers # 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: ## 2022-10-11 GNB: was: Data <- .align.timeSeries(data)/100 ## assuming that data is a 'timeSeries' objec, which seems it is, ## but I was not able to verify this since there are no examples with it ## and the documentation is unclear (or rather, I got lost). ## Note: the timeSeries method for align() is '.align.timeSeries' Data <- align(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.R0000644000176200001440000001264614254636366016073 0ustar liggesusers # 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.R0000644000176200001440000006267714254636366016453 0ustar liggesusers # 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/mathprogLP-neos.R0000644000176200001440000001663414254636366015771 0ustar liggesusers # 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.R0000644000176200001440000002704514254636366016660 0ustar liggesusers # 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.R0000644000176200001440000001622114421035661015141 0ustar liggesusers # 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 (in parma) # .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 (ported to and currently located in package parma) # 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 <- .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 <- parma::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) } ################################################################################ ## Imported from package Rsocp .SqrtMatrix <- function(x) { # A function implemented by Diethelm Wuertz # Description: # Square Root of a quadratic Matrix: # Example: # A = matrix(c(1,.2,.2,.2,1,.2,.2,.2,1), ncol = 3) # round(Sqrt(A) %*% Sqrt(A) - A, digits = 12) # FUNCTION: # Check if matrix is square: stopifnot(NCOL(x) == NROW(x)) # One-dimensional ? if (NCOL(x) == 1) return(sqrt(as.vector(x))) # Square Root of a matrix: e <- eigen(x) V <- e$vectors ans <- V %*% diag(sqrt(e$values)) %*% t(V) # Return Value: ans } ################################################################################ fPortfolio/R/mathprogNLP-solnp.R0000644000176200001440000002232114254636366016264 0ustar liggesusers # 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.R0000644000176200001440000001154214254636366016337 0ustar liggesusers # 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.R0000644000176200001440000001424514254636366017633 0ustar liggesusers # 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.R0000644000176200001440000002473314254636366017110 0ustar liggesusers # 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.R0000644000176200001440000001162214254636366016533 0ustar liggesusers # 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/mathprogQP-neos.R0000644000176200001440000001740514254636366015773 0ustar liggesusers # 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.R0000644000176200001440000002350714254636366016670 0ustar liggesusers # 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.R0000644000176200001440000002642014254636366020064 0ustar liggesusers # 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.R0000644000176200001440000001602614254636366015523 0ustar liggesusers # 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.R0000644000176200001440000001326614254636366016042 0ustar liggesusers # 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.R0000644000176200001440000000613114420254764017005 0ustar liggesusers # 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 (inherits(data,"timeSeries")) { series = data = sort(data) assetsNames = colnames(data) } else if (inherits(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 (inherits(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 (inherits(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.R0000644000176200001440000001271314421027025016151 0ustar liggesusers # 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 # 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) } # ------------------------------------------------------------------------------ .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.R0000644000176200001440000000235014254636366016072 0ustar liggesusers # 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.R0000644000176200001440000000461714254636366017334 0ustar liggesusers # 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.R0000644000176200001440000000554714254636366015647 0ustar liggesusers # 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.R0000644000176200001440000001563514254636366016654 0ustar liggesusers # 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.R0000644000176200001440000005314314254636366016416 0ustar liggesusers # 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.R0000644000176200001440000003112014254636366016761 0ustar liggesusers # 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.R0000644000176200001440000001313614254636366015755 0ustar liggesusers # 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.R0000644000176200001440000002534614420254764015364 0ustar liggesusers ################################################################################ # 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 (inherits(getSeries(object),"logical")) { cat("\nTarget Return and Risk:\n") target = target[, c(1, 3), drop = FALSE] colnames(target) = c("mean", "Cov") } else if(inherits(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.R0000644000176200001440000001737514254636366016601 0ustar liggesusers # 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.R0000644000176200001440000000203514254636366016222 0ustar liggesusers ################################################################################ # 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.R0000644000176200001440000001537514254636366016654 0ustar liggesusers # 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.R0000644000176200001440000001266114254636366016360 0ustar liggesusers # 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/MD50000644000176200001440000002214514421703056012713 0ustar liggesusersf7037c6c004470b858b04105af54d8d8 *ChangeLog 0c1b4c0d15f9f4160f2ee456eccd6317 *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 c805abb85c8dcd06259cacc5ef230398 *R/backtest-Plots.R a6181db0bbae1b94f0c977985354752f *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 257f8ac4eaa689879f7c87f2142f089c *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 162afc039c2bade0702b63c275c397db *R/mathprogNLP-nlminb2.R 163951e5af04a0f23a8d5296bfdf69bb *R/mathprogNLP-solnp.R 3ddf056876a7c9e856dc4232709f7fe1 *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 facc9dd9c6bd8cbff4f125a211689e75 *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 065f1fab7369dd00bdb7649d2c4962cf *R/object-portfolioConstraints.R 5b882a3b2be16013f7d4fb47b197eaee *R/object-portfolioData.R 4b3338dda4bc5cb72c5aaa95db457f5b *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 31f0a425400d47dcc12eca3c5591c00c *R/portfolio-efficientFrontier.R 760d0e43bc1ea0e0e3754069d1926780 *R/portfolio-efficientPfolio.R 9a8abfb08695fe67008b16eb8a1d33b9 *R/portfolio-feasiblePfolio.R 4ca83d7b214c3826ff6b4c09dcdbd852 *R/portfolio-riskPfolio.R 46a83e737d99e7e5bd84af5ce7c08192 *R/portfolio-rollingPfolio.R 3ab6aa74ee174cbe753eb858410232a9 *R/risk-budgeting.R 6b2bda65ae63852841f14a5c7e29a2ae *R/risk-covEstimator.R 381f99e393a11577ccbe7d279486143c *R/risk-pfolioMeasures.R 9d73ea66767ab704c447aa6de202fda2 *R/risk-surfaceRisk.R 1f66b7bae522ee57658524c5449224d8 *R/risk-tailBudgets.R 9c39859563c928ef4ac367130d52d8fe *R/risk-ternaryMap.R 460497d2d16d2d9e53a4c964d67a3844 *R/solve-Rampl.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 6eead6c6c7d7b6f96117ebf0aeab563f *R/solve-Rsocp.R ac68b9d18d143730cf5a7aa2814356e9 *R/solve-Rsolnp.R a14dd59f26f02d9ecc2259f694c03083 *R/solve-RtwoAssets.R 5ffa1a117cc651bd95d05b11d245c67b *R/solve-environment.R 6eebc74fc991f9ed6a983ab636fe873a *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 41baddbed179a86b0cfd702e29edd6a9 *R/utils-specs.R 53208dc3190d0a1c729f80ce8767dea9 *R/zzz.R 95d67c9faf7bfdc7da8e96a8b7e196c9 *data/ECON85.csv.gz c2ce5e17b69d7a9f1f061da6f56f3f14 *data/ECON85LONG.csv.gz 84e46cd7f37a1ef23e2af3cec871175f *data/GCCINDEX.RET.rda 8c6803194ef5189087e883921f2122b1 *data/GCCINDEX.rda 3ac068e79b54d09dcb53eb1a6c2bf3fd *data/LPP2005.RET.rda 783fc278d29df7431641c7fe49b347fa *data/LPP2005.rda e5df0bc935b5876d741b1729c09d8d35 *data/SMALLCAP.RET.rda 628c78d617f384a953b146f985606978 *data/SMALLCAP.rda 6d017e6cc90b719255abe93ffd6f0db9 *data/SPISECTOR.RET.rda daa5ee6da2199aacb68864b8804348a8 *data/SPISECTOR.rda efee963c851f28e80ef51fae93ef0080 *data/SWX.RET.rda bf608e3349ddb4296165536ee5006bfd *data/SWX.rda d41d8cd98f00b204e9800998ecf8427e *inst/LICENSE_AMPL 4a01a472db7fb700bd56c34b4c206375 *inst/LICENSE_GLPK f47716c075ed103781e2a77a0ede2477 *inst/LICENSE_QUADPROG ee15c3afc720f0b9f24f6196cdf5e3b8 *inst/LICENSE_SOCP fb62e6486baa854b494dbdc570262dd0 *inst/LICENSE_SOLNP 39bf63f0ae7a0acf3b46fe34d14b5a48 *inst/ReferenceCard.txt 445ae4c3417aa210e78a7cd3783db23c *inst/obsolete/zzz.Deprecated.R 60450acd0bfb6cebef1b5bfc4d1a1c97 *man/00fPortfolio-package.Rd 8068833535e7a78e2b56b37d738c9a10 *man/a-class-fPFOLIOBACKTEST.Rd 4630021f7d22f8343efb110ab9413224 *man/a-class-fPFOLIOCON.Rd 0146be7c56345243b568c06ed733cf34 *man/a-class-fPFOLIODATA.Rd f83b1b089b78f4817f8671acd058f76f *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 16c27ea6947c100c885cde0bf86f09c2 *man/mathprog-NLP.Rd 16101ab5b26ddd6b4ac8c2478089d04c *man/mathprog-QP.Rd df2004d179c1ae4ed483ee7c51cd4f2e *man/methods-plot.Rd d9b58bfcea01dcada88d9e915213a030 *man/methods-show.Rd be398146a051f2a342be788268eed0e0 *man/methods-summary.Rd c4daa0c54c65686d68262bc1b65f8396 *man/monitor-stability.Rd 913505e5a7f2756bb02810d39e30ffab *man/nlminb2.Rd 4b094e2b788b66d902e10500db22ef62 *man/nlminb2Control.Rd 8120d1f53f768e5cd82c187a44285b19 *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 e08db335ae2da98d23acc94b3b18513d *man/risk-surfaceRisk.Rd e1d61f177c1aeb2cab0016e4c9d7d527 *man/risk-ternaryMap.Rd 1cb09c273225056e632bdda650989074 *man/solve-environment.Rd 865662e941bf529a6b1b759ea3b124a6 *man/solver-ampl.Rd 395f6a747f5b33a3533f5a8f73d993e2 *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/0000755000176200001440000000000014421024623013350 5ustar liggesusersfPortfolio/inst/obsolete/0000755000176200001440000000000014254636366015205 5ustar liggesusersfPortfolio/inst/obsolete/zzz.Deprecated.R0000644000176200001440000006701614254636366020236 0ustar liggesusers # 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_SOCP0000644000176200001440000000127514254636366015227 0ustar liggesusers--- 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_AMPL0000644000176200001440000000000014254636366015175 0ustar liggesusersfPortfolio/inst/LICENSE_QUADPROG0000644000176200001440000000144714254636366015706 0ustar liggesusersc 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_SOLNP0000644000176200001440000000237014254636366015353 0ustar liggesusersFrom: 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.txt0000644000176200001440000014127714421024623016615 0ustar liggesusers 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-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 Rnlminb2::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 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-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_GLPK0000644000176200001440000000300514254636366015211 0ustar liggesusers 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 .