[Robast-commits] r1162 - branches/robast-1.2/pkg/RobAStBase/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Aug 18 23:27:19 CEST 2018


Author: ruckdeschel
Date: 2018-08-18 23:27:19 +0200 (Sat, 18 Aug 2018)
New Revision: 1162

Modified:
   branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R
   branches/robast-1.2/pkg/RobAStBase/R/getRiskIC.R
   branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R
   branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
Log:
[RobAStBase] branch 1.2
+ some additional safety layer: check if diagnostic slot is not NULL before assigning a class to it

Modified: branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R	2018-08-18 21:07:33 UTC (rev 1161)
+++ branches/robast-1.2/pkg/RobAStBase/R/CheckMakeIC.R	2018-08-18 21:27:19 UTC (rev 1162)
@@ -26,7 +26,7 @@
         }
         if(diagnostic){
            attr(res, "diagnostic") <- diagn[1:nrvalues]
-           class(attr(res,"diagnostic")) <- "DiagnosticClass"
+           if(!is.null(diagn)) class(attr(res,"diagnostic")) <- "DiagnosticClass"
         }
         erg <- matrix(0, ncol = dims, nrow = nrvalues)
 
@@ -39,7 +39,7 @@
             }
         if(diagnostic){
            attr(erg, "diagnostic") <- diagn[-(1:nrvalues)]
-           class(attr(erg,"diagnostic")) <- "DiagnosticClass"
+           if(!is.null(diagn)) class(attr(erg,"diagnostic")) <- "DiagnosticClass"
         }
         return(list(E.IC=res,E.IC.L=erg))
 }
@@ -90,7 +90,8 @@
         if(diagnostic){
            attr(prec,"diagnostic") <- c(attr(res$E.IC,"diagnostic"),
                                         attr(res$E.IC.L,"diagnostic"))
-           class(attr(prec,"diagnostic")) <- "DiagnosticClass"
+           if(!is.null(attr(prec,"diagnostic")))
+              class(attr(prec,"diagnostic")) <- "DiagnosticClass"
         }
         return(prec)
     })
@@ -145,7 +146,8 @@
         if(diagnostic){
            attr(IC.0,"diagnostic") <- c(attr(res$E.IC,"diagnostic"),
                                         attr(res$E.IC.L,"diagnostic"))
-           class(attr(IC.0,"diagnostic")) <- "DiagnosticClass"
+           if(!is.null(attr(IC.0,"diagnostic")))
+              class(attr(IC.0,"diagnostic")) <- "DiagnosticClass"
         }
         return(IC.0)
     })

Modified: branches/robast-1.2/pkg/RobAStBase/R/getRiskIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/getRiskIC.R	2018-08-18 21:07:33 UTC (rev 1161)
+++ branches/robast-1.2/pkg/RobAStBase/R/getRiskIC.R	2018-08-18 21:27:19 UTC (rev 1162)
@@ -66,7 +66,8 @@
         # if(withCheck) .checkICWithWarning(IC, L2Fam, tol, ...)
         if(diagnostic){
            attr(Cova,"diagnostic") <- diagn
-           class(attr(Cova,"diagnostic")) <- "DiagnosticClass"
+           if(!is.null(attr(Cova,"diagnostic")))
+               class(attr(Cova,"diagnostic")) <- "DiagnosticClass"
         }
         return(list(asCov = list(distribution = .getDistr(L2Fam), value = Cova)))
     })

Modified: branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R	2018-08-18 21:07:33 UTC (rev 1161)
+++ branches/robast-1.2/pkg/RobAStBase/R/getboundedIC.R	2018-08-18 21:27:19 UTC (rev 1162)
@@ -64,7 +64,8 @@
         res <- as(stand %*% L2w0, "EuclRandVariable")
         if(diagnostic){
            attr(res,"diagnostic") <- diagn
-           class(attr(res,"diagnostic")) <- "DiagnosticClass"
+           if(!is.null(attr(res,"diagnostic")))
+              class(attr(res,"diagnostic")) <- "DiagnosticClass"
         }
         return(res)
 }

Modified: branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R	2018-08-18 21:07:33 UTC (rev 1161)
+++ branches/robast-1.2/pkg/RobAStBase/R/kStepEstimator.R	2018-08-18 21:27:19 UTC (rev 1162)
@@ -510,7 +510,8 @@
         attr(estres,"timings") <- apply(sytm,2,diff)
         if(diagnostic){
            attr(estres,"diagnostic") <- diagn
-           class(attr(estres,"diagnostic")) <- "DiagnosticClass"
+           if(!is.null(diagn))
+              class(attr(estres,"diagnostic")) <- "DiagnosticClass"
         }
         on.exit()
         return(estres)



More information about the Robast-commits mailing list