Author: stamats
Date: 2008-08-06 15:40:14 +0200 (Wed, 06 Aug 2008)
New Revision: 242
Modified:
branches/distr-2.0/pkg/distrMod/R/L2GroupFamilies.R
branches/distr-2.0/pkg/distrMod/R/L2ParamFamily.R
Log:
new implementation of methods for modifyModel; old implementation led to invalid slots "fam.call".
Modified: branches/distr-2.0/pkg/distrMod/R/L2GroupFamilies.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/L2GroupFamilies.R 2008-08-06 07:50:50 UTC (rev 241)
+++ branches/distr-2.0/pkg/distrMod/R/L2GroupFamilies.R 2008-08-06 13:40:14 UTC (rev 242)
@@ -96,22 +96,38 @@
function(model, param, ...){
theta <- main(param)
if(is(model at distrSymm, "SphericalSymmetry")){
- M <- L2LocationFamily(loc = theta,
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- trafo = param at trafo)
+ M0 <- substitute(L2LocationFamily(loc = th,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ trafo = Trafo),
+ list(th = theta,
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}else{
- M <- L2LocationFamily(loc = theta,
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- distrSymm = NoSymmetry(),
- trafo = param at trafo)
+ M0 <- substitute(L2LocationFamily(loc = th,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ distrSymm = NoSymmetry(),
+ trafo = Trafo),
+ list(th = theta,
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}
M1 <- existsPIC(M)
return(M)
@@ -227,22 +243,38 @@
function(model, param, ...){
theta <- main(param)
if(is(model at distrSymm, "SphericalSymmetry")){
- M <- L2ScaleFamily(loc = theta,
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- trafo = param at trafo)
+ M0 <- substitute(L2ScaleFamily(loc = th,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ trafo = Trafo),
+ list(th = theta,
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}else{
- M <- L2ScaleFamily(loc = theta,
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- distrSymm = NoSymmetry(),
- trafo = param at trafo)
+ M0 <- substitute(L2ScaleFamily(loc = th,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ distrSymm = NoSymmetry(),
+ trafo = Trafo),
+ list(th = theta,
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}
M1 <- existsPIC(M)
return(M)
@@ -653,69 +685,121 @@
theta <- c(main(param), nuisance(param))
if(!length(nuisance(param))){
if(is(model at distrSymm, "SphericalSymmetry")){
- M <- L2LocationScaleFamily(loc = theta[1],
- scale = theta[2],
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- trafo = param at trafo)
+ M0 <- substitute(L2LocationScaleFamily(loc = th1,
+ scale = th2,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ trafo = Trafo),
+ list(th1 = theta[1],
+ th2 = theta[2],
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}else{
- M <- L2LocationScaleFamily(loc = theta[1],
- scale = theta[2],
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- distrSymm = NoSymmetry(),
- trafo = param at trafo)
+ M0 <- substitute(L2LocationScaleFamily(loc = th1,
+ scale = th2,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ distrSymm = NoSymmetry(),
+ trafo = Trafo),
+ list(th1 = theta[1],
+ th2 = theta[2],
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}
}else{
if(names(main(model)) %in% c("scale", "sd")){
if(is(model at distrSymm, "SphericalSymmetry")){
- M <- L2ScaleUnknownLocationFamily(loc = theta[2],
- scale = theta[1],
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- distrSymm = NoSymmetry(),
- trafo = param at trafo)
+ M0 <- substitute(L2ScaleUnknownLocationFamily(loc = th2,
+ scale = th1,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ trafo = Trafo),
+ list(th2 = theta[2],
+ th1 = theta[1],
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}else{
- M <- L2ScaleUnknownLocationFamily(loc = theta[2],
- scale = theta[1],
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- distrSymm = NoSymmetry(),
- trafo = param at trafo)
+ M0 <- substitute(L2ScaleUnknownLocationFamily(loc = th2,
+ scale = th1,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ distrSymm = NoSymmetry(),
+ trafo = Trafo),
+ list(th2 = theta[2],
+ th1 = theta[1],
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}
}else{
if(is(model at distrSymm, "SphericalSymmetry")){
- M <- L2LocationUnknownScaleFamily(loc = theta[1],
- scale = theta[2],
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- distrSymm = NoSymmetry(),
- trafo = param at trafo)
+ M0 <- substitute(L2LocationUnknownScaleFamily(loc = th1,
+ scale = th2,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ trafo = Trafo),
+ list(th1 = theta[1],
+ th2 = theta[2],
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}else{
- M <- L2LocationUnknownScaleFamily(loc = theta[1],
- scale = theta[2],
- name = model at name,
- distribution = model at modifyParam(theta),
- modParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- distrSymm = NoSymmetry(),
- trafo = param at trafo)
+ M0 <- substitute(L2LocationUnknownScaleFamily(loc = th1,
+ scale = th2,
+ name = Name,
+ distribution = D0,
+ modParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ distrSymm = NoSymmetry(),
+ trafo = Trafo),
+ list(th1 = theta[1],
+ th2 = theta[2],
+ Name = model at name,
+ D0 = model at modifyParam(theta),
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ Trafo = param at trafo))
+ M <- eval(M0)
}
}
}
Modified: branches/distr-2.0/pkg/distrMod/R/L2ParamFamily.R
===================================================================
--- branches/distr-2.0/pkg/distrMod/R/L2ParamFamily.R 2008-08-06 07:50:50 UTC (rev 241)
+++ branches/distr-2.0/pkg/distrMod/R/L2ParamFamily.R 2008-08-06 13:40:14 UTC (rev 242)
@@ -139,16 +139,27 @@
setMethod("modifyModel", signature(model = "L2ParamFamily", param = "ParamFamParameter"),
function(model, param, ...){
theta <- c(main(param),nuisance(param))
- M <- L2ParamFamily(name = model at name,
- distribution = model at modifyParam(theta),
- param = param,
- props = model at props,
- startPar = model at startPar,
- makeOKPar = model at makeOKPar,
- modifyParam = model at modifyParam,
- L2deriv.fct = model at L2deriv.fct,
- FisherInfo.fct = model at FisherInfo.fct,
- FisherInfo = model at FisherInfo.fct(param))
+ M0 <- substitute(L2ParamFamily(name = Name,
+ distribution = D,
+ param = P,
+ props = Props,
+ startPar = Par0,
+ makeOKPar = ParOK,
+ modifyParam = modPar,
+ L2deriv.fct = L2fct,
+ FisherInfo.fct = F.fct,
+ FisherInfo = FInfo),
+ list(Name = model at name,
+ D = model at modifyParam(theta),
+ P = param,
+ Props = model at props,
+ Par0 = model at startPar,
+ ParOK = model at makeOKPar,
+ modPar = model at modifyParam,
+ L2fct = model at L2deriv.fct,
+ F.fct = model at FisherInfo.fct,
+ FInfo = model at FisherInfo.fct(param)))
+ M <- eval(M0)
M1 <- existsPIC(M)
return(M)
})