Nothing
#+#########################################################################+
### Fault object. store error conditions. \
### Slots: /
### Faults in program, depends on methods contains: /
### FL: 'logical', if True (T) error, other Slots will \
### be NULL, if False (F) no error method converged \
### FN: 'integer' error number, if equal(0) zero no error, \
### otherwise is the number of error returned back by \
### the method, some times the number shows an warning |
### it means output exist i.e (FL=F), but some |
### convergence problem occured. the number must be |
### defined inside the method. /
### FT: Text of error, will be generated by each function. |
### FF: name of the function that the error is raise. |
###
############################################################################+
setClass("Fault", representation(FL = "logical",FN = "numeric",FT="character",FF="character"))
Fault <- function(FL = F,FN=0,FT=NULL,FF=NULL,pnt=F){
if(FN==0) {return(new("Fault",FL=FALSE,FN=FN,FT="",FF=""))}
if( is.null(FT) & is.null(FF) )
return( new( "Fault", FL=nlr::db.Fault$FL[nlr::db.Fault$FN==FN],
FN=FN,
FT=nlr::db.Fault$FT[nlr::db.Fault$FN==FN],
FF = nlr::db.Fault$FF[nlr::db.Fault$FN==FN]))
if( is.null(FT) & (! is.null(FF)) ) {
return( new( "Fault", FL=nlr::db.Fault$FL[nlr::db.Fault$FN==FN],
FN=FN,
FT=nlr::db.Fault$FT[nlr::db.Fault$FN==FN],
FF = FF))
}
if( (! is.null(FT)) & is.null(FF) )
return( new( "Fault", FL=nlr::db.Fault$FL[nlr::db.Fault$FN==FN],
FN=FN,
FT=FT,
FF=nlr::db.Fault$FF[nlr::db.Fault$FN==FN]))
Fault2 <- new("Fault",FL=FL,FN=FN,FF=FF)
if(pnt) print(Fault2)
return(Fault2)
}
###################################################
## Method $, Fault.
###################################################
setMethod("$","Fault",
function(x,name){
slot(x,name)
}
)
#+#################################################################+
#| End of the object 'Fault' |
#| 28/09/2008 |
#| Hossein Riazoshams, UPM, NSPEM |
#+#################################################################+
###################################################
## function is.Fault, return true if Fault object
## or Fault list is true FF
###################################################
"is.Fault" <- function(obj){
if( class(obj)=="Fault")
if(obj$FL) return(T)
else return(F)
flt2 <- F
if(.hasSlot(obj,"Fault"))
if(obj$Fault$FL) flt2 <- T
return(flt2)
}
###########################################################
## function is.Faultwarn, return true if Fault object
## or Fault list is true FF and or warning hapened
###########################################################
"is.Faultwarn" <- function(obj){
if( class(obj)=="Fault")
if(obj$FN != 0) return(T)
flt2 <- F
if(! is.null(obj$Fault))
if(obj$Fault$FN != 0) flt2 <- T
return(flt2)
}
###########################################################
## function is.warn, return true if warning object
## only is true if warning hapened,
## if error happen return false.
###########################################################
"is.Warn" <- function(obj){
if( class(obj)=="Fault")
if(obj$FN != 0 && ! obj$FL) return(T)
else return(F)
flt2 <- F
if(! is.null(obj$Fault))
if(obj$Fault$FN != 0 && ! obj$Fault$FL) flt2 <- T
return(flt2)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.