[Distr-commits] r254 - branches/distr-2.0/pkg/distrMod/R

[noreply at r-forge.r-project.org]

Author: stamats
Date: 2008-08-08 19:42:00 +0200 (Fri, 08 Aug 2008)
New Revision: 254

Modified:
   branches/distr-2.0/pkg/distrMod/R/SimpleL2ParamFamilies.R
   branches/distr-2.0/pkg/distrMod/R/modifyModel.R
Log:
"dangerous" implementation for casting in modifyModel!
as(..., ...) leads to infinite recursions ...

Modified: branches/distr-2.0/pkg/distrMod/R/SimpleL2ParamFamilies.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/SimpleL2ParamFamilies.R	2008-08-08 17:11:45 UTC (rev 253)
+++ branches/distr-2.0/pkg/distrMod/R/SimpleL2ParamFamilies.R	2008-08-08 17:42:00 UTC (rev 254)
@@ -553,7 +553,7 @@
                   L2derivDistrSymm = DistrSymmList(NoSymmetry()),
                   trafo = trafo, .returnClsName = "ExpScaleFamily")
     f.call <- substitute(ExpScaleFamily(scale = s,
-                          trafo = matrix(Tr, dimnames = list("scale","scale"))),
+                         trafo = matrix(Tr, dimnames = list("scale","scale"))),
                          list(s = scale, Tr = trafo))
     res at fam.call <- f.call
     return(res)

Modified: branches/distr-2.0/pkg/distrMod/R/modifyModel.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/modifyModel.R	2008-08-08 17:11:45 UTC (rev 253)
+++ branches/distr-2.0/pkg/distrMod/R/modifyModel.R	2008-08-08 17:42:00 UTC (rev 254)
@@ -68,6 +68,7 @@
           }
 
           M at fam.call <- fam.call
+          class(M) <- class(model)
           return(M)
           })
 
@@ -94,7 +95,8 @@
                 names(cl)[cl.l+1] <- loc.name
              }
              M at fam.call <- cl
-             return(as(M, "L2LocationFamily"))
+             class(M) <- class(model)
+             return(M)
           })
 
 setMethod("modifyModel", signature(model = "L2ScaleFamily",
@@ -128,7 +130,8 @@
                 names(cl)[cl.l] <- scale.name
              }
              M at fam.call <- cl
-             return(as(M, "L2ScaleFamily"))
+             class(M) <- class(model)
+             return(M)
           })
 
 setMethod("modifyModel", signature(model = "L2LocationScaleFamily",
@@ -168,7 +171,8 @@
                 names(cl)[cl.l] <- scale.name
              }
              M at fam.call <- cl
-             return(as(M, "L2LocationScaleFamily"))
+             class(M) <- class(model)
+             return(M)
           })
 
 setMethod("modifyModel", signature(model = "GammaFamily",
@@ -176,12 +180,19 @@
           function(model, param, ...){
              M <- modifyModel(as(model, "L2ParamFamily"), param = param,
                               .withCall = FALSE)
-             M at L2derivDistrSymm <- DistrSymmList(SphericalSymmetry(
-                                                   SymmCenter = loc),
-                                                 NoSymmetry())
              M at L2derivSymm <- FunSymmList(OddSymmetric(SymmCenter = 
                                                        prod(main(param))),
                                           NonSymmetric())
-             return(as(M, "GammaFamily"))
+             class(M) <- class(model)
+             return(M)
           })
+setMethod("modifyModel", signature(model = "ExpScaleFamily",
+           param = "ParamFamParameter"),
+          function(model, param, ...){
+             M <- modifyModel(as(model, "L2ParamFamily"), param = param,
+                              .withCall = FALSE)
+             M at L2derivSymm <- FunSymmList(OddSymmetric(SymmCenter = main(param)))
+             class(M) <- class(model)
+             return(M)
+          })