[Robast-commits] r392 - in pkg: . ROptEst ROptEst/R ROptEst/chm ROptEst/inst ROptEst/inst/scripts ROptEst/man ROptEstOld ROptEstOld/R ROptEstOld/chm ROptEstOld/man ROptRegTS ROptRegTS/chm ROptRegTS/inst ROptRegTS/man RandVar RandVar/R RandVar/chm RandVar/inst RandVar/inst/doc RandVar/man RandVar/tests RobAStBase RobAStBase/R RobAStBase/chm RobAStBase/inst RobAStBase/man RobLox RobLox/R RobLox/chm RobLox/inst RobLox/man RobLoxBioC RobLoxBioC/inst RobLoxBioC/man RobRex RobRex/chm RobRex/inst

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Nov 1 11:47:37 CET 2009


Author: stamats
Date: 2009-11-01 11:47:36 +0100 (Sun, 01 Nov 2009)
New Revision: 392

Added:
   pkg/ROptEst/R/getInfLM.R
   pkg/ROptEst/chm/getinfLM.html
   pkg/ROptEst/chm/internals.html
   pkg/ROptEst/inst/TOBEDONE
   pkg/ROptEst/man/getinfLM.Rd
   pkg/ROptEst/man/internals.Rd
   pkg/ROptEst/tests/
   pkg/ROptEstOld/inst/
   pkg/ROptRegTS/inst/TOBEDONE
   pkg/ROptRegTS/tests/
   pkg/RandVar-check-output.txt
   pkg/RandVar/inst/TOBEDONE
   pkg/RandVar/tests/Examples/
   pkg/RandVar/tests/tests.Rout.save
   pkg/RobAStBase/R/getboundedIC.R
   pkg/RobAStBase/R/kStepEstimate.R
   pkg/RobAStBase/R/kStepEstimatorStart.R
   pkg/RobAStBase/R/masked.R
   pkg/RobAStBase/R/qqplot.R
   pkg/RobAStBase/inst/MASKING
   pkg/RobAStBase/inst/TOBEDONE
   pkg/RobAStBase/man/OptionalInfluenceCurve-Class.Rd
   pkg/RobAStBase/man/RobAStBaseMASK.Rd
   pkg/RobAStBase/man/getBoundedIC.Rd
   pkg/RobAStBase/man/internals-qqplot.Rd
   pkg/RobAStBase/man/kStepEstimatorStart-methods.Rd
   pkg/RobAStBase/man/masked-methods.Rd
   pkg/RobAStBase/man/qqplot.Rd
   pkg/RobAStBase/tests/
   pkg/RobLox/inst/TOBEDONE
   pkg/RobLox/tests/
   pkg/RobLoxBioC/inst/TOBEDONE
   pkg/RobLoxBioC/tests/
   pkg/RobRex/inst/TOBEDONE
   pkg/RobRex/tests/
Removed:
   pkg/ROptEstOld/R/DistrSymmList.R
   pkg/ROptEstOld/R/PosDefSymmMatrix.R
   pkg/ROptEstOld/man/DistrSymmList-class.Rd
   pkg/ROptEstOld/man/DistrSymmList.Rd
   pkg/ROptEstOld/man/DistributionSymmetry-class.Rd
   pkg/ROptEstOld/man/EllipticalSymmetry-class.Rd
   pkg/ROptEstOld/man/EllipticalSymmetry.Rd
   pkg/ROptEstOld/man/NoSymmetry-class.Rd
   pkg/ROptEstOld/man/NoSymmetry.Rd
   pkg/ROptEstOld/man/OptionalNumeric-class.Rd
   pkg/ROptEstOld/man/PosDefSymmMatrix-class.Rd
   pkg/ROptEstOld/man/PosDefSymmMatrix.Rd
   pkg/ROptEstOld/man/SphericalSymmetry-class.Rd
   pkg/ROptEstOld/man/SphericalSymmetry.Rd
   pkg/ROptEstOld/man/Symmetry-class.Rd
   pkg/RandVar/inst/doc/RandVar.pdf
Modified:
   pkg/ROptEst/DESCRIPTION
   pkg/ROptEst/NAMESPACE
   pkg/ROptEst/R/AllGeneric.R
   pkg/ROptEst/R/LowerCaseMultivariate.R
   pkg/ROptEst/R/cniperCont.R
   pkg/ROptEst/R/getAsRisk.R
   pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R
   pkg/ROptEst/R/getIneffDiff.R
   pkg/ROptEst/R/getInfCent.R
   pkg/ROptEst/R/getInfClip.R
   pkg/ROptEst/R/getInfGamma.R
   pkg/ROptEst/R/getInfRobIC_asBias.R
   pkg/ROptEst/R/getInfRobIC_asCov.R
   pkg/ROptEst/R/getInfRobIC_asGRisk.R
   pkg/ROptEst/R/getInfRobIC_asHampel.R
   pkg/ROptEst/R/getInfRobIC_asUnOvShoot.R
   pkg/ROptEst/R/getInfStand.R
   pkg/ROptEst/R/getInfV.R
   pkg/ROptEst/R/getModifyIC.R
   pkg/ROptEst/R/leastFavorableRadius.R
   pkg/ROptEst/R/optIC.R
   pkg/ROptEst/R/optRisk.R
   pkg/ROptEst/R/radiusMinimaxIC.R
   pkg/ROptEst/R/roptest.R
   pkg/ROptEst/chm/00Index.html
   pkg/ROptEst/chm/0ROptEst-package.html
   pkg/ROptEst/chm/ROptEst.chm
   pkg/ROptEst/chm/ROptEst.hhp
   pkg/ROptEst/chm/ROptEst.toc
   pkg/ROptEst/chm/cniperCont.html
   pkg/ROptEst/chm/getAsRisk.html
   pkg/ROptEst/chm/getBiasIC.html
   pkg/ROptEst/chm/getFiRisk.html
   pkg/ROptEst/chm/getFixClip.html
   pkg/ROptEst/chm/getFixRobIC.html
   pkg/ROptEst/chm/getIneffDiff.html
   pkg/ROptEst/chm/getInfCent.html
   pkg/ROptEst/chm/getInfClip.html
   pkg/ROptEst/chm/getInfGamma.html
   pkg/ROptEst/chm/getInfRobIC.html
   pkg/ROptEst/chm/getInfStand.html
   pkg/ROptEst/chm/getInfV.html
   pkg/ROptEst/chm/getL1normL2deriv.html
   pkg/ROptEst/chm/getL2normL2deriv.html
   pkg/ROptEst/chm/getModifyIC.html
   pkg/ROptEst/chm/getRiskIC.html
   pkg/ROptEst/chm/leastFavorableRadius.html
   pkg/ROptEst/chm/lowerCaseRadius.html
   pkg/ROptEst/chm/minmaxBias.html
   pkg/ROptEst/chm/optIC.html
   pkg/ROptEst/chm/optRisk.html
   pkg/ROptEst/chm/radiusMinimaxIC.html
   pkg/ROptEst/chm/roptest.html
   pkg/ROptEst/chm/updateNorm-methods.html
   pkg/ROptEst/inst/NEWS
   pkg/ROptEst/inst/scripts/BinomialModel.R
   pkg/ROptEst/inst/scripts/ExponentialScaleModel.R
   pkg/ROptEst/inst/scripts/GumbelLocationModel.R
   pkg/ROptEst/inst/scripts/LognormalAndNormalModel.R
   pkg/ROptEst/inst/scripts/NormalLocationScaleModel.R
   pkg/ROptEst/inst/scripts/PoissonModel.R
   pkg/ROptEst/man/0ROptEst-package.Rd
   pkg/ROptEst/man/getAsRisk.Rd
   pkg/ROptEst/man/getFixRobIC.Rd
   pkg/ROptEst/man/getIneffDiff.Rd
   pkg/ROptEst/man/getInfCent.Rd
   pkg/ROptEst/man/getInfClip.Rd
   pkg/ROptEst/man/getInfGamma.Rd
   pkg/ROptEst/man/getInfRobIC.Rd
   pkg/ROptEst/man/getInfStand.Rd
   pkg/ROptEst/man/getInfV.Rd
   pkg/ROptEst/man/getModifyIC.Rd
   pkg/ROptEst/man/getRiskIC.Rd
   pkg/ROptEst/man/leastFavorableRadius.Rd
   pkg/ROptEst/man/minmaxBias.Rd
   pkg/ROptEst/man/optIC.Rd
   pkg/ROptEst/man/radiusMinimaxIC.Rd
   pkg/ROptEst/man/roptest.Rd
   pkg/ROptEstOld/DESCRIPTION
   pkg/ROptEstOld/NAMESPACE
   pkg/ROptEstOld/R/AllClass.R
   pkg/ROptEstOld/R/AllGeneric.R
   pkg/ROptEstOld/R/AllShow.R
   pkg/ROptEstOld/R/Symmetry.R
   pkg/ROptEstOld/chm/00Index.html
   pkg/ROptEstOld/chm/EvenSymmetric.html
   pkg/ROptEstOld/chm/FunctionSymmetry-class.html
   pkg/ROptEstOld/chm/OddSymmetric.html
   pkg/ROptEstOld/chm/ROptEstOld.chm
   pkg/ROptEstOld/chm/ROptEstOld.toc
   pkg/ROptEstOld/chm/TotalVarIC-class.html
   pkg/ROptEstOld/chm/asUnOvShoot-class.html
   pkg/ROptEstOld/chm/fiUnOvShoot-class.html
   pkg/ROptEstOld/man/EvenSymmetric.Rd
   pkg/ROptEstOld/man/FunctionSymmetry-class.Rd
   pkg/ROptEstOld/man/GammaFamily.Rd
   pkg/ROptEstOld/man/OddSymmetric.Rd
   pkg/ROptEstOld/man/TotalVarIC-class.Rd
   pkg/ROptEstOld/man/asUnOvShoot-class.Rd
   pkg/ROptEstOld/man/fiUnOvShoot-class.Rd
   pkg/ROptRegTS/DESCRIPTION
   pkg/ROptRegTS/chm/00Index.html
   pkg/ROptRegTS/chm/Av1CondContIC-class.html
   pkg/ROptRegTS/chm/Av1CondContIC.html
   pkg/ROptRegTS/chm/Av1CondContNeighborhood-class.html
   pkg/ROptRegTS/chm/Av1CondContNeighborhood.html
   pkg/ROptRegTS/chm/Av1CondNeighborhood-class.html
   pkg/ROptRegTS/chm/Av1CondTotalVarIC-class.html
   pkg/ROptRegTS/chm/Av1CondTotalVarIC.html
   pkg/ROptRegTS/chm/Av1CondTotalVarNeighborhood-class.html
   pkg/ROptRegTS/chm/Av1CondTotalVarNeighborhood.html
   pkg/ROptRegTS/chm/Av2CondContIC-class.html
   pkg/ROptRegTS/chm/Av2CondContIC.html
   pkg/ROptRegTS/chm/Av2CondContNeighborhood-class.html
   pkg/ROptRegTS/chm/Av2CondContNeighborhood.html
   pkg/ROptRegTS/chm/Av2CondNeighborhood-class.html
   pkg/ROptRegTS/chm/AvCondNeighborhood-class.html
   pkg/ROptRegTS/chm/CondContIC-class.html
   pkg/ROptRegTS/chm/CondContIC.html
   pkg/ROptRegTS/chm/CondContNeighborhood-class.html
   pkg/ROptRegTS/chm/CondContNeighborhood.html
   pkg/ROptRegTS/chm/CondIC-class.html
   pkg/ROptRegTS/chm/CondIC.html
   pkg/ROptRegTS/chm/CondNeighborhood-class.html
   pkg/ROptRegTS/chm/CondTotalVarIC-class.html
   pkg/ROptRegTS/chm/CondTotalVarIC.html
   pkg/ROptRegTS/chm/CondTotalVarNeighborhood-class.html
   pkg/ROptRegTS/chm/CondTotalVarNeighborhood.html
   pkg/ROptRegTS/chm/FixRobRegTypeModel-class.html
   pkg/ROptRegTS/chm/FixRobRegTypeModel.html
   pkg/ROptRegTS/chm/InfRobRegTypeModel-class.html
   pkg/ROptRegTS/chm/InfRobRegTypeModel.html
   pkg/ROptRegTS/chm/L2RegTypeFamily-class.html
   pkg/ROptRegTS/chm/L2RegTypeFamily.html
   pkg/ROptRegTS/chm/NormLinRegFamily.html
   pkg/ROptRegTS/chm/NormLinRegInterceptFamily.html
   pkg/ROptRegTS/chm/NormLinRegScaleFamily.html
   pkg/ROptRegTS/chm/RegTypeFamily-class.html
   pkg/ROptRegTS/chm/RegTypeFamily.html
   pkg/ROptRegTS/chm/generateIC-methods.html
   pkg/ROptRegTS/chm/getAsRiskRegTS.html
   pkg/ROptRegTS/chm/getFiRiskRegTS.html
   pkg/ROptRegTS/chm/getFixClipRegTS.html
   pkg/ROptRegTS/chm/getFixRobRegTypeIC.html
   pkg/ROptRegTS/chm/getIneffDiff-methods.html
   pkg/ROptRegTS/chm/getInfCentRegTS.html
   pkg/ROptRegTS/chm/getInfClipRegTS.html
   pkg/ROptRegTS/chm/getInfGammaRegTS.html
   pkg/ROptRegTS/chm/getInfRobRegTypeIC.html
   pkg/ROptRegTS/chm/getInfStandRegTS.html
   pkg/ROptRegTS/chm/leastFavorableRadius-methods.html
   pkg/ROptRegTS/chm/optIC-methods.html
   pkg/ROptRegTS/chm/radiusMinimaxIC-methods.html
   pkg/ROptRegTS/inst/NEWS
   pkg/ROptRegTS/man/CondIC-class.Rd
   pkg/ROptRegTS/man/CondNeighborhood-class.Rd
   pkg/ROptRegTS/man/FixRobRegTypeModel-class.Rd
   pkg/ROptRegTS/man/InfRobRegTypeModel-class.Rd
   pkg/ROptRegTS/man/RegTypeFamily-class.Rd
   pkg/ROptRegTS/man/generateIC-methods.Rd
   pkg/ROptRegTS/man/getAsRiskRegTS.Rd
   pkg/ROptRegTS/man/getFiRiskRegTS.Rd
   pkg/ROptRegTS/man/getFixClipRegTS.Rd
   pkg/ROptRegTS/man/getIneffDiff-methods.Rd
   pkg/ROptRegTS/man/getInfCentRegTS.Rd
   pkg/ROptRegTS/man/getInfClipRegTS.Rd
   pkg/ROptRegTS/man/getInfGammaRegTS.Rd
   pkg/ROptRegTS/man/getInfStandRegTS.Rd
   pkg/ROptRegTS/man/leastFavorableRadius-methods.Rd
   pkg/ROptRegTS/man/optIC-methods.Rd
   pkg/ROptRegTS/man/radiusMinimaxIC-methods.Rd
   pkg/RandVar/DESCRIPTION
   pkg/RandVar/R/Expectation.R
   pkg/RandVar/R/Matrixmult.R
   pkg/RandVar/chm/00Index.html
   pkg/RandVar/chm/EuclRandMatrix-class.html
   pkg/RandVar/chm/EuclRandMatrix.html
   pkg/RandVar/chm/EuclRandVarList-class.html
   pkg/RandVar/chm/EuclRandVarList.html
   pkg/RandVar/chm/EuclRandVariable-class.html
   pkg/RandVar/chm/EuclRandVariable.html
   pkg/RandVar/chm/OptionalrSpace-class.html
   pkg/RandVar/chm/RandVar.chm
   pkg/RandVar/chm/RandVar.hhp
   pkg/RandVar/chm/RandVariable-class.html
   pkg/RandVar/chm/RandVariable.html
   pkg/RandVar/chm/RealRandVariable-class.html
   pkg/RandVar/chm/RealRandVariable.html
   pkg/RandVar/chm/util.html
   pkg/RandVar/inst/NEWS
   pkg/RandVar/man/0RandVar-package.Rd
   pkg/RandVar/man/EuclRandMatrix-class.Rd
   pkg/RandVar/man/EuclRandVarList-class.Rd
   pkg/RandVar/man/EuclRandVariable-class.Rd
   pkg/RandVar/man/RandVariable-class.Rd
   pkg/RandVar/man/RealRandVariable-class.Rd
   pkg/RandVar/tests/tests.R
   pkg/RobAStBase/DESCRIPTION
   pkg/RobAStBase/NAMESPACE
   pkg/RobAStBase/R/AllClass.R
   pkg/RobAStBase/R/AllGeneric.R
   pkg/RobAStBase/R/AllPlot.R
   pkg/RobAStBase/R/AllShow.R
   pkg/RobAStBase/R/ContIC.R
   pkg/RobAStBase/R/IC.R
   pkg/RobAStBase/R/Neighborhood.R
   pkg/RobAStBase/R/RobAStBaseOptions.R
   pkg/RobAStBase/R/RobModel.R
   pkg/RobAStBase/R/TotalVarIC.R
   pkg/RobAStBase/R/Weights.R
   pkg/RobAStBase/R/bALEstimate.R
   pkg/RobAStBase/R/comparePlot.R
   pkg/RobAStBase/R/generateICfct.R
   pkg/RobAStBase/R/getBiasIC.R
   pkg/RobAStBase/R/getRiskIC.R
   pkg/RobAStBase/R/infoPlot.R
   pkg/RobAStBase/R/kStepEstimator.R
   pkg/RobAStBase/R/locMEstimator.R
   pkg/RobAStBase/R/oneStepEstimator.R
   pkg/RobAStBase/R/optIC.R
   pkg/RobAStBase/chm/00Index.html
   pkg/RobAStBase/chm/0RobAStBase-package.html
   pkg/RobAStBase/chm/ALEstimate-class.html
   pkg/RobAStBase/chm/BdStWeight-class.html
   pkg/RobAStBase/chm/BoundedWeight-class.html
   pkg/RobAStBase/chm/ContIC-class.html
   pkg/RobAStBase/chm/ContIC.html
   pkg/RobAStBase/chm/ContNeighborhood-class.html
   pkg/RobAStBase/chm/ContNeighborhood.html
   pkg/RobAStBase/chm/FixRobModel-class.html
   pkg/RobAStBase/chm/FixRobModel.html
   pkg/RobAStBase/chm/HampIC-class.html
   pkg/RobAStBase/chm/HampelWeight-class.html
   pkg/RobAStBase/chm/IC-class.html
   pkg/RobAStBase/chm/IC.html
   pkg/RobAStBase/chm/InfRobModel-class.html
   pkg/RobAStBase/chm/InfRobModel.html
   pkg/RobAStBase/chm/InfluenceCurve-class.html
   pkg/RobAStBase/chm/InfluenceCurve.html
   pkg/RobAStBase/chm/MEstimate-class.html
   pkg/RobAStBase/chm/Neighborhood-class.html
   pkg/RobAStBase/chm/RobAStBase.chm
   pkg/RobAStBase/chm/RobAStBase.hhp
   pkg/RobAStBase/chm/RobAStBase.toc
   pkg/RobAStBase/chm/RobAStBaseOptions.html
   pkg/RobAStBase/chm/RobAStControl-class.html
   pkg/RobAStBase/chm/RobModel-class.html
   pkg/RobAStBase/chm/RobWeight-class.html
   pkg/RobAStBase/chm/TotalVarIC-class.html
   pkg/RobAStBase/chm/TotalVarIC.html
   pkg/RobAStBase/chm/TotalVarNeighborhood-class.html
   pkg/RobAStBase/chm/TotalVarNeighborhood.html
   pkg/RobAStBase/chm/UncondNeighborhood-class.html
   pkg/RobAStBase/chm/checkIC.html
   pkg/RobAStBase/chm/comparePlot.html
   pkg/RobAStBase/chm/cutoff-class.html
   pkg/RobAStBase/chm/cutoff.html
   pkg/RobAStBase/chm/ddPlot-methods.html
   pkg/RobAStBase/chm/evalIC.html
   pkg/RobAStBase/chm/generateIC.html
   pkg/RobAStBase/chm/generateICfct.html
   pkg/RobAStBase/chm/getBiasIC.html
   pkg/RobAStBase/chm/getRiskIC.html
   pkg/RobAStBase/chm/getweight.html
   pkg/RobAStBase/chm/infoPlot.html
   pkg/RobAStBase/chm/internals.html
   pkg/RobAStBase/chm/internals_ddPlot.html
   pkg/RobAStBase/chm/kStepEstimate-class.html
   pkg/RobAStBase/chm/kStepEstimator.html
   pkg/RobAStBase/chm/locMEstimator.html
   pkg/RobAStBase/chm/makeIC-methods.html
   pkg/RobAStBase/chm/oneStepEstimator.html
   pkg/RobAStBase/chm/optIC.html
   pkg/RobAStBase/chm/outlyingPlotIC.html
   pkg/RobAStBase/chm/plot-methods.html
   pkg/RobAStBase/inst/NEWS
   pkg/RobAStBase/man/0RobAStBase-package.Rd
   pkg/RobAStBase/man/ALEstimate-class.Rd
   pkg/RobAStBase/man/BdStWeight-class.Rd
   pkg/RobAStBase/man/BoundedWeight-class.Rd
   pkg/RobAStBase/man/ContIC-class.Rd
   pkg/RobAStBase/man/ContNeighborhood-class.Rd
   pkg/RobAStBase/man/FixRobModel-class.Rd
   pkg/RobAStBase/man/HampIC-class.Rd
   pkg/RobAStBase/man/HampelWeight-class.Rd
   pkg/RobAStBase/man/IC-class.Rd
   pkg/RobAStBase/man/InfRobModel-class.Rd
   pkg/RobAStBase/man/InfluenceCurve-class.Rd
   pkg/RobAStBase/man/MEstimate-class.Rd
   pkg/RobAStBase/man/Neighborhood-class.Rd
   pkg/RobAStBase/man/RobAStBaseOptions.Rd
   pkg/RobAStBase/man/RobAStControl-class.Rd
   pkg/RobAStBase/man/RobModel-class.Rd
   pkg/RobAStBase/man/RobWeight-class.Rd
   pkg/RobAStBase/man/TotalVarIC-class.Rd
   pkg/RobAStBase/man/TotalVarNeighborhood-class.Rd
   pkg/RobAStBase/man/UncondNeighborhood-class.Rd
   pkg/RobAStBase/man/comparePlot.Rd
   pkg/RobAStBase/man/getRiskIC.Rd
   pkg/RobAStBase/man/infoPlot.Rd
   pkg/RobAStBase/man/internals_ddPlot.Rd
   pkg/RobAStBase/man/kStepEstimate-class.Rd
   pkg/RobAStBase/man/kStepEstimator.Rd
   pkg/RobAStBase/man/locMEstimator.Rd
   pkg/RobAStBase/man/oneStepEstimator.Rd
   pkg/RobAStBase/man/plot-methods.Rd
   pkg/RobLox/DESCRIPTION
   pkg/RobLox/R/colRoblox.R
   pkg/RobLox/R/roblox.R
   pkg/RobLox/R/rowRoblox.R
   pkg/RobLox/chm/00Index.html
   pkg/RobLox/chm/RobLox.chm
   pkg/RobLox/chm/RobLox.hhp
   pkg/RobLox/chm/RobLox.toc
   pkg/RobLox/chm/roblox.html
   pkg/RobLox/chm/rowRoblox.html
   pkg/RobLox/inst/NEWS
   pkg/RobLox/man/0RobLox-package.Rd
   pkg/RobLox/man/roblox.Rd
   pkg/RobLox/man/rowRoblox.Rd
   pkg/RobLoxBioC/DESCRIPTION
   pkg/RobLoxBioC/inst/NEWS
   pkg/RobLoxBioC/man/0RobLoxBioC-package.Rd
   pkg/RobLoxBioC/man/KolmogorovMinDist.Rd
   pkg/RobLoxBioC/man/robloxbioc.Rd
   pkg/RobRex/DESCRIPTION
   pkg/RobRex/chm/00Index.html
   pkg/RobRex/chm/rgsOptIC.AL.html
   pkg/RobRex/chm/rgsOptIC.ALc.html
   pkg/RobRex/chm/rgsOptIC.ALs.html
   pkg/RobRex/chm/rgsOptIC.BM.html
   pkg/RobRex/chm/rgsOptIC.M.html
   pkg/RobRex/chm/rgsOptIC.MK.html
   pkg/RobRex/chm/rgsOptIC.Mc.html
   pkg/RobRex/chm/rgsOptIC.Ms.html
   pkg/RobRex/inst/NEWS
Log:
merged branch 0.7 into trunk

Modified: pkg/ROptEst/DESCRIPTION
===================================================================
--- pkg/ROptEst/DESCRIPTION	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/DESCRIPTION	2009-11-01 10:47:36 UTC (rev 392)
@@ -1,15 +1,14 @@
 Package: ROptEst
 Version: 0.7
-Date: 2009-04-22
+Date: 2009-10-16
 Title: Optimally robust estimation
-Description: Optimally robust estimation in general smoothly
-        parameterized models using S4 classes and methods.
-Depends: R(>= 2.7.0), methods, distr(>= 2.0), distrEx(>= 2.0),
-        distrMod(>= 2.0), RandVar(>= 0.6.4), RobAStBase
+Description: Optimally robust estimation in general smoothly parameterized models using S4 classes and methods.
+Depends: R(>= 2.7.0), methods, distr(>= 2.0), distrEx(>= 2.0), distrMod(>= 2.0), RandVar(>= 0.6.4), RobAStBase
 Author: Matthias Kohl, Peter Ruckdeschel
 Maintainer: Matthias Kohl <Matthias.Kohl at stamats.de>
 LazyLoad: yes
 License: LGPL-3
 URL: http://robast.r-forge.r-project.org/
+Encoding: latin1
 LastChangedDate: {$LastChangedDate$}
 LastChangedRevision: {$LastChangedRevision$}

Modified: pkg/ROptEst/NAMESPACE
===================================================================
--- pkg/ROptEst/NAMESPACE	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/NAMESPACE	2009-11-01 10:47:36 UTC (rev 392)
@@ -25,6 +25,6 @@
               "getL1normL2deriv",
               "getModifyIC",
               "cniperCont", "cniperPoint", "cniperPointPlot")
-exportMethods("updateNorm")
+exportMethods("updateNorm", "scaleUpdateIC")
 export("getL2normL2deriv")
-export("roptest")
+export("roptest","getLagrangeMultByOptim","getLagrangeMultByIter")

Modified: pkg/ROptEst/R/AllGeneric.R
===================================================================
--- pkg/ROptEst/R/AllGeneric.R	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/R/AllGeneric.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -72,8 +72,11 @@
     setGeneric("updateNorm", function(normtype, ...) standardGeneric("updateNorm"))
 }
 if(!isGeneric("getModifyIC")){
-    setGeneric("getModifyIC", function(L2FamIC, neighbor, risk) standardGeneric("getModifyIC"))
+    setGeneric("getModifyIC", function(L2FamIC, neighbor, risk, ...) standardGeneric("getModifyIC"))
 }
+if(!isGeneric("scaleUpdateIC")){
+    setGeneric("scaleUpdateIC", function(neighbor, ...) standardGeneric("scaleUpdateIC"))
+}
 if(!isGeneric("cniperCont")){
     setGeneric("cniperCont", function(IC1, IC2, L2Fam, neighbor, risk, ...) standardGeneric("cniperCont"))
 }

Modified: pkg/ROptEst/R/LowerCaseMultivariate.R
===================================================================
--- pkg/ROptEst/R/LowerCaseMultivariate.R	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/R/LowerCaseMultivariate.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -1,11 +1,15 @@
 .LowerCaseMultivariate <- function(L2deriv, neighbor, biastype,
-             normtype, Distr, trafo, z.start,
-             A.start, z.comp, A.comp, maxiter, tol){
+             normtype, Distr, Finfo, trafo, z.start = NULL,
+             A.start = NULL, z.comp = NULL, A.comp = NULL, maxiter, tol,
+             verbose = NULL){
 
+        if(missing(verbose)|| is.null(verbose))
+           verbose <- getRobAStBaseOption("all.verbose")
+
         w <- new("HampelWeight")
 
         if(is.null(z.start)) z.start <- numeric(ncol(trafo))
-        if(is.null(A.start)) A.start <- trafo
+        if(is.null(A.start)) A.start <- trafo%*%solve(as.matrix(Finfo))
         if(is.null(A.comp)) 
            A.comp <- matrix(TRUE, nrow = nrow(trafo), ncol = ncol(trafo))
         if(is.null(z.comp)) 
@@ -19,14 +23,16 @@
             return(fct(normtype)(Y))
         }
 
+        itermin <- 0
         bmin.fct <- function(param, L2deriv, Distr, trafo){
+            itermin <<- itermin + 1
             p <- nrow(trafo)
             k <- ncol(trafo)
             A <- matrix(0, ncol = k, nrow = p)
             A[A.comp] <- param[1:lA.comp]
             z <- numeric(k)
             z[z.comp] <- param[(lA.comp+1):length(param)]
-            
+
 #            if(is(normtype,"SelfNorm")) 
 #               A <- A/max(A)
             
@@ -51,6 +57,12 @@
             erg <- E1/sum(diag(stA %*% t(trafo)))
             clip(w0) <- 1/erg
             w <<- w0
+            if(verbose && itermin %% 15 == 1){
+               cat("trying to find lower case solution;\n")
+               cat("current Lagrange Multiplier value:\n")
+               print(list(A=A, z=z,erg=erg))
+               }
+
             return(erg)
         }
 
@@ -61,7 +73,68 @@
                     control = list(reltol = tol, maxit = 100*maxiter),
                     L2deriv = L2deriv, Distr = Distr, trafo = trafo)
 
-        return(list(erg=erg, w=w, normtype = normtype, z.comp = z.comp))
+
+        return(list(erg=erg, w=w, normtype = normtype, z.comp = z.comp, itermin = itermin))
     }
 
 
+.LowerCaseMultivariateTV <- function(L2deriv, neighbor, biastype,
+             normtype, Distr, Finfo, trafo,
+             A.start = NULL,  maxiter, tol,
+             verbose = NULL){
+
+        if(missing(verbose)|| is.null(verbose))
+           verbose <- getRobAStBaseOption("all.verbose")
+
+        w <- new("BdStWeight")
+        k <- ncol(trafo)
+
+        if(is.null(A.start)) A.start <- trafo%*%solve(Finfo)
+
+        pos.fct <- function(x, L2, stand){
+            X <- evalRandVar(L2, as.matrix(x))[,,1]
+            Y <- stand %*% X
+            return(Y*(Y>0))
+        }
+
+        itermin <- 0
+
+        bmin.fct <- function(param, L2deriv, Distr, trafo){
+            itermin <<- itermin + 1
+            p <- 1
+            A <- matrix(param, ncol = k, nrow = 1)
+         #   print(A)
+            E1 <- E(object = Distr, fun = pos.fct, L2 = L2deriv, stand = A,
+                    useApply = FALSE)
+            erg <- E1/sum(diag(A %*% t(trafo)))
+            return(erg)
+        }
+
+        erg <- optim(as.numeric(A.start), bmin.fct, method = "Nelder-Mead",
+                    control = list(reltol = tol, maxit = 100*maxiter),
+                    L2deriv = L2deriv, Distr = Distr, trafo = trafo)
+
+        A <- matrix(erg$par, ncol = k, nrow = 1)
+        b <- 1/erg$value
+        stand(w) <- A
+
+        pr.fct <- function(x, L2, pr.sign=1){
+                  X <- evalRandVar(L2, as.matrix(x)) [,,1]
+                  Y <- as.numeric(A %*% X)
+                  return(as.numeric(pr.sign*Y>0))
+                  }
+        p.p   <- E(object = Distr, fun = pr.fct, L2 = L2deriv,
+                   useApply = FALSE, pr.sign =  1)
+        m.p   <- E(object = Distr, fun = pr.fct, L2 = L2deriv,
+                   useApply = FALSE, pr.sign = -1)
+
+
+        a <- -b * p.p/(p.p+m.p)
+        
+        clip(w) <- c(0,b)+a
+        weight(w) <- minbiasweight(w, neighbor = neighbor,
+                                           biastype = biastype,
+                                           normW = normtype)
+        return(list(A=A,b=b, w=w, a=a, itermin = itermin))
+    }
+

Modified: pkg/ROptEst/R/cniperCont.R
===================================================================
--- pkg/ROptEst/R/cniperCont.R	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/R/cniperCont.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -32,11 +32,12 @@
                                    neighbor = "ContNeighborhood",
                                    risk = "asMSE"),
     function(L2Fam, neighbor, risk, lower, upper){
-        tr.invF <- sum(diag(solve(FisherInfo(L2Fam))))
+        D <- trafo(L2Fam at param)
+        tr.invF <- sum(diag(D %*% solve(FisherInfo(L2Fam)) %*% t(D)))
         psi <- optIC(model = L2Fam, risk = asCov())
         robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
         eta <- optIC(model = robMod, risk = asMSE())
-        maxMSE <- Risks(eta)$asMSE
+        maxMSE <- Risks(eta)$asMSE$value
         Delta <- sqrt(maxMSE - tr.invF)/neighbor at radius
         fun <- function(x){
             y <- evalIC(psi, x) 
@@ -50,11 +51,12 @@
                                    neighbor = "ContNeighborhood",
                                    risk = "asMSE"),
     function(L2Fam, neighbor, risk, lower, upper, n = 101){
-        tr.invF <- sum(diag(solve(FisherInfo(L2Fam))))
+        D <- trafo(L2Fam at param)
+        tr.invF <- sum(diag(D %*% solve(FisherInfo(L2Fam)) %*% t(D)))
         psi <- optIC(model = L2Fam, risk = asCov())
         robMod <- InfRobModel(center = L2Fam, neighbor = neighbor)
         eta <- optIC(model = robMod, risk = asMSE())
-        maxMSE <- Risks(eta)$asMSE
+        maxMSE <- Risks(eta)$asMSE$value
         fun <- function(x){
             y <- evalIC(psi, x) 
             tr.invF + as.vector(y %*% y)*neighbor at radius^2 - maxMSE

Modified: pkg/ROptEst/R/getAsRisk.R
===================================================================
--- pkg/ROptEst/R/getAsRisk.R	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/R/getAsRisk.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -58,11 +58,16 @@
                                  neighbor = "ContNeighborhood", 
                                  biastype = "ANY"),
     function(risk, L2deriv, neighbor, biastype, Distr, DistrSymm, L2derivSymm,
-             L2derivDistrSymm, trafo, z.start, A.start,  maxiter, tol, warn){                
+             L2derivDistrSymm, Finfo, trafo, z.start, A.start,  maxiter, tol, warn,
+             verbose = NULL){
         
+        if(missing(verbose)|| is.null(verbose))
+           verbose <- getRobAStBaseOption("all.verbose")
+
         normtype <- normtype(risk)
         biastype <- biastype(risk)
 
+
         if(is(normtype,"SelfNorm")){
                 warntxt <- paste(gettext(
                 "Using self-standardization, there are problems with the existence\n"
@@ -75,18 +80,43 @@
         comp <- .getComp(L2deriv, DistrSymm, L2derivSymm, L2derivDistrSymm)
         z.comp <- comp$"z.comp"
         A.comp <- comp$"A.comp"
+        DA.comp <- abs(trafo) %*% A.comp != 0
         
         eerg <- .LowerCaseMultivariate(L2deriv = L2deriv, neighbor = neighbor, 
-             biastype = biastype, normtype = normtype, Distr = Distr, 
-             trafo = trafo, z.start = z.start, A.start, z.comp = z.comp, 
-             A.comp = A.comp,  maxiter = maxiter, tol = tol)
+             biastype = biastype, normtype = normtype, Distr = Distr,  Finfo = Finfo,
+             trafo = trafo, z.start = z.start, A.start = A.start, z.comp = z.comp,
+             A.comp = DA.comp,  maxiter = maxiter, tol = tol, verbose = verbose)
         erg <- eerg$erg
         bias <- 1/erg$value
         
         return(list(asBias = bias, normtype = eerg$normtype))
     })
+setMethod("getAsRisk", signature(risk = "asBias",
+                                 L2deriv = "RealRandVariable",
+                                 neighbor = "TotalVarNeighborhood",
+                                 biastype = "ANY"),
+    function(risk, L2deriv, neighbor, biastype, Distr, DistrSymm, L2derivSymm,
+             L2derivDistrSymm, Finfo, trafo, z.start, A.start,  maxiter, tol, warn,
+             verbose = NULL){
 
+        if(missing(verbose)|| is.null(verbose))
+           verbose <- getRobAStBaseOption("all.verbose")
 
+        normtype <- normtype(risk)
+        biastype <- biastype(risk)
+        Finfo <- FisherInfo(L2deriv)
+
+        eerg <- .LowerCaseMultivariateTV(L2deriv = L2deriv,
+             neighbor = neighbor, biastype = biastype,
+             normtype = normtype, Distr = Distr, Finfo = Finfo, trafo = trafo,
+             A.start = A.start, maxiter = maxiter,
+             tol = tol, verbose = verbose)
+        erg <- eerg$b
+
+        return(list(asBias = bias, normtype = eerg$normtype))
+    })
+
+
 ###############################################################################
 ## asymptotic covariance
 ###############################################################################

Modified: pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R
===================================================================
--- pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/R/getFixRobIC_fiUnOvShoot.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -4,7 +4,7 @@
 setMethod("getFixRobIC", signature(Distr = "Norm", 
                                    risk = "fiUnOvShoot", 
                                    neighbor = "UncondNeighborhood"),
-    function(Distr, risk, neighbor, sampleSize, upper, maxiter, tol, warn, 
+    function(Distr, risk, neighbor, sampleSize, upper, lower, maxiter, tol, warn,
              Algo, cont){
         radius <- neighbor at radius
         if(identical(all.equal(radius, 0), TRUE)){

Modified: pkg/ROptEst/R/getIneffDiff.R
===================================================================
--- pkg/ROptEst/R/getIneffDiff.R	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/R/getIneffDiff.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -6,23 +6,37 @@
                                     neighbor = "UncondNeighborhood",
                                     risk = "asMSE"),
     function(radius, L2Fam, neighbor, risk, loRad, upRad, loRisk, upRisk, 
-             z.start = NULL, A.start = NULL, upper.b, MaxIter, eps, warn,
-             loNorm = NULL, upNorm = NULL, verbose = FALSE){
+             z.start = NULL, A.start = NULL, upper.b = NULL, lower.b = NULL,
+             OptOrIter = "iterate", MaxIter, eps, warn,
+             loNorm = NULL, upNorm = NULL,
+             verbose = NULL, ...){
+
+        if(missing(verbose)|| is.null(verbose))
+           verbose <- getRobAStBaseOption("all.verbose")
         L2derivDim <- numberOfMaps(L2Fam at L2deriv)
         if(L2derivDim == 1){
+            ##print(radius)
             neighbor at radius <- radius
             res <- getInfRobIC(L2deriv = L2Fam at L2derivDistr[[1]], neighbor = neighbor, 
                         risk = risk, symm = L2Fam at L2derivDistrSymm[[1]], 
-                        Finfo = L2Fam at FisherInfo, upper = upper.b,
-                        trafo = L2Fam at param@trafo, maxiter = MaxIter, tol = eps, 
+                        Finfo = L2Fam at FisherInfo, upper = upper.b, lower = lower.b,
+                        trafo = trafo(L2Fam at param),
+                        maxiter = MaxIter, tol = eps,
                         warn = warn, verbose = verbose)
-            trafo <- as.vector(L2Fam at param@trafo)
+            trafo <- as.vector(trafo(L2Fam at param))
             ineffLo <- (as.vector(res$A)*trafo - res$b^2*(radius^2-loRad^2))/loRisk
+            ####cat("---------------\n")
+            ##res00=res;res00$w <- NULL; res00$biastype <- NULL; res00$d <- NULL
+            ##res00$normtype <- NULL;res00$info <- NULL;res00$risk <- NULL;
+            ##print(res00)
+            ##print(c(lower.b,upper.b,loRisk,"upR"=upRisk))
+            ####cat("---------------\n")
             if(upRad == Inf)
                 ineffUp <- res$b^2/upRisk
             else
                 ineffUp <- (as.vector(res$A)*trafo - res$b^2*(radius^2-upRad^2))/upRisk
             assign("ineff", ineffUp, envir = sys.frame(which = -4))
+            ##print(c(ineffUp,ineffLo,ineffUp - ineffLo))
             return(ineffUp - ineffLo)
         }else{
             if(is(L2Fam at distribution, "UnivariateDistribution")){
@@ -45,17 +59,20 @@
                         L2derivDistrSymm <- new("DistrSymmList", L2)
                     }
                 }
-                trafo <- L2Fam at param@trafo
+                trafo <- trafo(L2Fam at param)
                 p <- nrow(trafo)
                 neighbor at radius <- radius
                 res <- getInfRobIC(L2deriv = L2deriv, neighbor = neighbor, risk = risk, 
                             Distr = L2Fam at distribution, DistrSymm = L2Fam at distrSymm, 
                             L2derivSymm = L2derivSymm, L2derivDistrSymm = L2derivDistrSymm, 
                             Finfo = L2Fam at FisherInfo, trafo = trafo, z.start = z.start, 
-                            A.start = A.start, upper = upper.b, maxiter = MaxIter, 
-                            tol = eps, warn = warn, verbose = verbose)
+                            A.start = A.start, upper = upper.b, lower = lower.b,
+                            OptOrIter = OptOrIter, maxiter = MaxIter,
+                            tol = eps, warn = warn, verbose = verbose,
+                            withPICcheck = FALSE,...)
                 normtype(risk) <- res$normtype
-                std <- if(is(normtype(risk),"QFNorm")) QuadForm(normtype(risk)) else diag(p)
+                std <- if(is(normtype(risk),"QFNorm"))
+                          QuadForm(normtype(risk)) else diag(p)
 
                 biasLo <- biasUp <- res$b
 
@@ -84,7 +101,13 @@
                                 biasUp^2*(radius^2-upRad^2))/upRisk}
                 assign("ineff", ineffUp, envir = sys.frame(which = -4))
                 if(verbose)
-                    cat("current radius:\t", radius, "\tMSE-inefficiency difference:\t", ineffUp - ineffLo, "\n")
+                    cat(paste(rep("-",75), sep = "", collapse = ""),"\n",
+                        "current radius:   ", round(radius,4),
+                        "\tMSE-inefficiency difference:   ",
+                        round(ineffUp - ineffLo,4),
+                        paste("\n",paste(rep("-",75), sep = "",
+                                         collapse = ""),"\n",sep="")
+                        )
 
                 return(ineffUp - ineffLo)
             }else{

Modified: pkg/ROptEst/R/getInfCent.R
===================================================================
--- pkg/ROptEst/R/getInfCent.R	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/R/getInfCent.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -11,8 +11,8 @@
         z.fct <- function(z, c0, D1){
             return(c0 + (z-c0)*p(D1)(z-c0) - (z+c0)*p(D1)(z+c0) + m1df(D1, z+c0) - m1df(D1, z-c0))
         }
-        lower <- q(L2deriv)(getdistrOption("TruncQuantile"))
-        upper <- q(L2deriv)(1-getdistrOption("TruncQuantile"))
+        lower <- getLow(L2deriv)
+        upper <- getUp(L2deriv)
 
         return(uniroot(z.fct, lower = lower, upper = upper, tol = tol.z, 
                     c0=clip, D1=L2deriv)$root)
@@ -26,19 +26,45 @@
 
         D1 <- sign(as.vector(trafo))*L2deriv
         g.fct <- function(g, c0, D1){
-            return(g*p(D1)(g) + (g+c0)*(1-p(D1)(g+c0)) - m1df(D1, g) + m1df(D1, g+c0))
+            return(g*p(D1)(g) + (g+c0)*(p(D1)(g+c0, lower.tail = FALSE)) - m1df(D1, g) + m1df(D1, g+c0))
         }
-        lower <- q(L2deriv)(getdistrOption("TruncQuantile"))
-        upper <- q(L2deriv)(1-getdistrOption("TruncQuantile"))
-
-        return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z, 
+        lower <- -clip
+        upper <- 0
+        return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
                     c0 = clip, D1 = D1)$root)
     })
 
+
 setMethod("getInfCent", signature(L2deriv = "RealRandVariable",
+                                  neighbor = "TotalVarNeighborhood",
+                                  biastype = "BiasType"),
+    function(L2deriv, neighbor, biastype, Distr, z.comp, w,
+             tol.z = .Machine$double.eps^.5){
+        stand <- stand(w)
+        clip <- clip(w)
+        b <- clip[2]-clip[1]
+        ### if(symm) return(b/2)
+
+        g.fct <- function(g, c0){
+            fct <- function(x){
+                  Lx <- evalRandVar(L2deriv, as.matrix(x)) [,,1]
+                  Y <- as.numeric(stand%*%Lx)
+                  pmin(pmax(g,Y),g+c0)
+                  }
+            return(E(object = Distr, fun = fct, useApply = FALSE))
+        }
+        lower <- -b
+        upper <- 0
+
+        return(uniroot(g.fct, lower = lower, upper = upper, tol = tol.z,
+                    c0 = b)$root)
+    })
+
+setMethod("getInfCent", signature(L2deriv = "RealRandVariable",
                                   neighbor = "ContNeighborhood",
                                   biastype = "BiasType"),
-    function(L2deriv, neighbor, biastype, Distr, z.comp, w){
+    function(L2deriv, neighbor, biastype, Distr, z.comp, w,
+             tol.z = .Machine$double.eps^.5){
         integrand1 <- function(x){
             weight(w)(evalRandVar(L2deriv, as.matrix(x)) [,,1]) 
         }
@@ -71,14 +97,14 @@
         z.fct <- function(z, c0, D1){
             return(c0 - (z+c0)*p(D1)(z+c0) + m1df(D1, z+c0))
         }
-        lower <- q(L2deriv)(getdistrOption("TruncQuantile"))
+        lower <- getLow(L2deriv)
         upper <- 0
         }else{
         z.fct <- function(z, c0, D1){
             return(- z + (z-c0)*p(D1)(z-c0) - m1df(D1, z-c0))
         }
         lower <- 0
-        upper <- q(L2deriv)(1-getdistrOption("TruncQuantile"))
+        upper <- getUp(L2deriv)
         }
         return(uniroot(z.fct, lower = lower, upper = upper, tol = tol.z,
                     c0=clip, D1=L2deriv)$root)
@@ -96,8 +122,8 @@
                    (z+c0/nu2)*p(D1)(z+c0/nu2) + m1df(D1, z+c0/nu2) -
                    m1df(D1, z-c0/nu1))
         }
-        lower <- q(L2deriv)(getdistrOption("TruncQuantile"))
-        upper <- q(L2deriv)(1-getdistrOption("TruncQuantile"))
+        lower <- getLow(L2deriv)
+        upper <- getUp(L2deriv)
 
         return(uniroot(z.fct, lower = lower, upper = upper, tol = tol.z,
                     c0=clip, D1=L2deriv)$root)

Modified: pkg/ROptEst/R/getInfClip.R
===================================================================
--- pkg/ROptEst/R/getInfClip.R	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/R/getInfClip.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -30,10 +30,10 @@
 setMethod("getInfClip", signature(clip = "numeric", 
                                   L2deriv = "EuclRandVariable",
                                   risk = "asMSE", 
-                                  neighbor = "ContNeighborhood"),
+                                  neighbor = "UncondNeighborhood"),
     function(clip, L2deriv, risk, neighbor, biastype, 
              Distr, stand, cent, trafo){
-        return(neighbor at radius^2*clip + 
+        return(neighbor at radius^2*clip +
                 getInfGamma(L2deriv = L2deriv, risk = risk, neighbor = neighbor, 
                             biastype = biastype, Distr = Distr, stand = stand, 
                             cent = cent, clip = clip))

Modified: pkg/ROptEst/R/getInfGamma.R
===================================================================
--- pkg/ROptEst/R/getInfGamma.R	2009-10-16 17:39:14 UTC (rev 391)
+++ pkg/ROptEst/R/getInfGamma.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -9,7 +9,7 @@
         c1 <- cent - clip
         c2 <- cent + clip
         return(m1df(L2deriv, c2) + m1df(L2deriv, c1) 
-                    - c1*p(L2deriv)(c1) + c2*(1-p(L2deriv)(c2)))
+                    - c1*p(L2deriv)(c1) + c2*p(L2deriv)(c2, lower.tail = FALSE))
     })
 ###############################################################################
 ## r^2 b = E(c - A Lambda)_+ Probleme mit Startwerten!!!
@@ -20,7 +20,8 @@
                                    neighbor = "TotalVarNeighborhood",
                                    biastype = "BiasType"),
     function(L2deriv, risk, neighbor, biastype, cent, clip){
-        return(m1df(L2deriv, cent+clip) + (cent+clip)*(1-p(L2deriv)(cent+clip)))
+        return(m1df(L2deriv, cent+clip) + (cent+clip)*p(L2deriv)(cent+clip,
+               lower.tail = FALSE))
     })
 
 setMethod("getInfGamma", signature(L2deriv = "RealRandVariable",
@@ -28,19 +29,36 @@
                                    neighbor = "ContNeighborhood",
                                    biastype = "BiasType"),
     function(L2deriv, risk, neighbor, biastype, Distr, 
-             stand, cent, clip){
-        integrandG <- function(x, L2, stand, cent, clip){ 
+             stand, cent, clip, power = 1L){
+        integrandG <- function(x, L2, stand, cent, clip){
             X <- evalRandVar(L2, as.matrix(x))[,,1] - cent
             Y <- stand %*% X
             res <- norm(risk)(Y) - clip
 
-            return((res > 0)*res)
+            return((res > 0)*res^power)
         }
 
         return(-E(object = Distr, fun = integrandG, L2 = L2deriv, 
                   stand = stand, cent = cent, clip = clip, useApply = FALSE))
     })
 
+setMethod("getInfGamma", signature(L2deriv = "RealRandVariable",
+                                   risk = "asMSE",
+                                   neighbor = "TotalVarNeighborhood",
+                                   biastype = "BiasType"),
+    function(L2deriv, risk, neighbor, biastype, Distr,
+             stand, cent, clip, power = 1L){
+        integrandG <- function(x, L2, stand, cent, clip){
+            X <- evalRandVar(L2, as.matrix(x))[,,1] - cent
+            Y <- stand %*% X
+            res <- Y - clip
+
+            return((res > 0)*res^power)
+        }
+
+        return(-E(object = Distr, fun = integrandG, L2 = L2deriv,
+                  stand = stand, cent = cent, clip = clip, useApply = FALSE))
+    })
 ###############################################################################
 ## gamma in case of asymptotic under-/overshoot risk
 ###############################################################################

Copied: pkg/ROptEst/R/getInfLM.R (from rev 391, branches/robast-0.7/pkg/ROptEst/R/getInfLM.R)
===================================================================
--- pkg/ROptEst/R/getInfLM.R	                        (rev 0)
+++ pkg/ROptEst/R/getInfLM.R	2009-11-01 10:47:36 UTC (rev 392)
@@ -0,0 +1,305 @@
+###################################################################################
+# Lagrange Multipliers either by iteration or by optimization  --- new 10-08-09
+###################################################################################
+
+getLagrangeMultByIter <- function(b, L2deriv, risk, trafo,
+                      neighbor, biastype, normtype, Distr,
+                      a.start, z.start, A.start, w.start, std,
+                      z.comp, A.comp, maxiter, tol,
+                      verbose = NULL, warnit = TRUE){
+        if(missing(verbose)|| is.null(verbose))
+           verbose <- getRobAStBaseOption("all.verbose")
+        LMcall <- match.call()
+
+        ## initialization
+        z <- z.start
+        A <- A.start
+        w <- w.start
+        iter <- 0
+        a <- a.start
+
+        ## iteration-loop
+        repeat{
+            ## increment
+            iter <- iter + 1
+            a.old <- a
+            z.old <- z
+            A.old <- A
+
+            ## update weight
+            if(is(neighbor,"ContNeighborhood")){
+                clip(w) <- b
+                cent(w) <- as.numeric(z)
+                stand(w) <- A
+            }else if(is(neighbor,"TotalVarNeighborhood")){
+                clip(w) <- if(.isVirginW(w)) c(-b,b)/2 else c(0,b)+a
+                stand(w) <- A
+            }
+            weight(w) <- getweight(w, neighbor = neighbor, biastype = biastype,
+                                   normW = normtype)
+
+        #     print(w)
+            ## update centering
+            z <- getInfCent(L2deriv = L2deriv, neighbor = neighbor,
+                            biastype = biastype, Distr = Distr, z.comp = z.comp,
+                            w = w, tol.z = .Machine$double.eps^.5)
+        #     print(c("z"=z))
+            if(is(neighbor,"TotalVarNeighborhood")){
+                  a <- z
+                  z <- as.numeric(solve(A,a))
+                  zc <- numeric(ncol(trafo))
+            }else if(is(neighbor,"ContNeighborhood")) {
+                  zc <- z
+            }
+
+            # update standardization
+            A <- getInfStand(L2deriv = L2deriv, neighbor = neighbor,
+                         biastype = biastype, Distr = Distr, A.comp = A.comp,
+                         cent = zc, trafo = trafo, w = w)
+
+        #     print(c("A"=A))
+            ## in case of self-standardization: update norm
+            normtype.old <- normtype
+            if(is(normtype,"SelfNorm")){
+               normtype(risk) <- normtype <- updateNorm(normtype = normtype,
+                   L2 = L2deriv, neighbor = neighbor, biastype = biastype,
+                   Distr = Distr, V.comp = A.comp, cent = zc, stand = A, w = w)
+            }
+
+            ## precision and iteration counting
+            prec <- max(max(abs(A-A.old)), max(abs(a-a.old)),max(abs(z-z.old)))
+#            if(verbose)
+#              .checkPIC(L2deriv = L2deriv, neighbor = neighbor,
+#                     Distr = Distr, trafo = trafo, z = zc, A = A, w = w,
+#                     z.comp = z.comp, A.comp = A.comp)
+
+            if(verbose && iter>1 && iter < maxiter && iter%%5 == 1){
+                cat("current precision in IC algo:\t", prec, "\n")
+                print(round(c(A=A,a=a),3))
+            }
+            if(prec < tol) break
+            if(iter > maxiter){
+                if(warnit)
+                   cat("maximum iterations reached!\n",
+                       "achieved precision:\t", prec, "\n")
+                break
+            }
+        }
+
+        ## determine LM a
+        if(is(neighbor,"ContNeighborhood"))
+           a <- as.vector(A %*% zc)
+
+        if(is(normtype,"QFNorm")) std <- QuadForm(normtype)
+
+        return(list(A = A, a = a, z = zc, w = w,
+                    biastype = biastype, normtype = normtype,
+                    normtype.old = normtype.old,
+                    risk = risk, std = std,
+                    iter = iter, prec = prec, b = b,
+                    call = LMcall ))
+}
+
+getLagrangeMultByOptim <- function(b, L2deriv, risk, FI, trafo,
+                      neighbor, biastype, normtype, Distr,
+                      a.start, z.start, A.start, w.start, std, z.comp,
+                      A.comp, maxiter, tol, verbose = NULL, ...){
+
+        if(missing(verbose)|| is.null(verbose))
+           verbose <- getRobAStBaseOption("all.verbose")
+        LMcall <- match.call()
+        ### manipulate dots in call -> set control argument for optim
+        dots <- list(...)
+        if(is.null(dots$method)) dots$method <- "L-BFGS-B"
+
+        if(!is.null(dots$control)){
+            if(is.null(dots$control$maxit)) dots$control$maxit <-  round(maxiter)
+            if(is.null(dots$control$reltol)) dots$control$reltol <- tol
+            if(is.null(dots$control$abstol)) dots$control$abstol <- tol
+        }else{
+            dots$control = list(maxit=min(round(maxiter),1e8), reltol=tol, abstol=tol)
+        }
+        #print(dots$control)
+        ## initialization
+        z <- z.start
+        A <- A.start
+        p <- nrow(trafo)
+        k <- ncol(trafo)
+
+        A0vec0 <- as.numeric(cbind(A, A%*%z))
+
+        lvec0 <- seq(along=A0vec0)
+        A0log <- as.logical(cbind(A.comp, as.logical(A.comp%*%as.numeric(z.comp)>0)))
+        lvlog <- lvec0[A0log]
+        A0vec1 <- A0vec0[A0log]
+#        print(list(A0vec0,A0log,lvlog,A0vec1))
+
+        iter1 <- 0
+        stdC  <- stdC.opt <- std
+        optV <- Inf
+        
+        risk1 <- risk1.opt <- risk
+        normtype1 <- normtype1.old <- normtype
+        normtype1.opt <- normtype1.opt.old <- normtype
+        w1.opt <- w1 <- w.start
+        z1.opt <- numeric(k)
+        b.opt <- b
+
+        optimfct <- function(A0vec){
+            iter1 <<- iter1 + 1
+#            print(A0vec)
+            A0vecA <- numeric(p*(k+1))
+
+            A0vecA[lvlog] <- A0vec
+
+            ### read out current value of LM in usual format
+            A0 <- matrix(A0vecA[1:(p*k)],nrow=p,ncol=k)
+            a0 <- as.numeric(A0vecA[(p*k)+(1:p)])
+
+#            print(list(A0vecA,A0,a0))
+
+            z0 <- as.numeric(solve(A0,a0))
+            std0 <- stdC
+            w0 <- w1
+            risk0 <- risk1
+            b0 <- b
+            
+            if(is(risk0,"asMSE")){
+            funint.opt <-
+                   function(b1){
+                      -getInfGamma(L2deriv = L2deriv, risk = risk0,
+                                 neighbor = neighbor, biastype = biastype,
+                                 Distr = Distr, stand = A0, cent = z0, clip = b1,
+                                 power = 2)+radius(neighbor)^2*b1^2
+                      }
+
+            b0 <- optimize(funint.opt, interval=c(1e-8,1e8))$minimum
+            }
+
+            ### determine corresponding weight
+            if(is(neighbor,"ContNeighborhood")){
+                clip(w0) <- b0
+                cent(w0) <- as.numeric(z0)
+                stand(w0) <- A0
+            }else if(is(neighbor,"TotalVarNeighborhood")){
+                clip(w0) <- if(.isVirginW(w0)) c(-b0,b0)/2 else c(0,b0)+a0
+                stand(w0) <- A0
+            }
+            weight(w0) <- getweight(w0, neighbor = neighbor, biastype = biastype,
+                                    normW = normtype1)
+
+            ### in case of self-standardization update norm:
+            if (is(normtype1,"SelfNorm"))
+                {
+                   ## transport current & precedent norm outside the optimizer:
+                   normtype1.old <<- normtype1
+                   normtype1 <<- updateNorm(normtype = normtype1,
+                                            L2 = L2deriv, neighbor = neighbor,
+                                            biastype = biastype, Distr = Distr,
+                                            V.comp = A.comp, cent = a0,
+                                            stand = A0, w = w0)
+                   normtype(risk0) <- normtype1
+                   ## transport current quadratic form & risk outside
+                   ## the optimizer:
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/robast -r 392


More information about the Robast-commits mailing list