Merge pull request #93 from hsloot/feat/show-methods

[feat] add `show`-methods

DESCRIPTION

@@ -37,6 +37,7 @@ Collate:
     'RcppExports.R'
     'allClass-S4.R'
     'allInitialize-S4.R'
+    'allShow-S4.R'
     'allValidity-S4.R'
     'catch-routine-registration.R'
     'levyDensity-S4.R'

NAMESPACE

@@ -48,6 +48,7 @@ exportMethods(exIntensities)
 exportMethods(exQMatrix)
 exportMethods(intensities)
 exportMethods(levyDensity)
+exportMethods(show)
 exportMethods(stieltjesDensity)
 exportMethods(uexIntensities)
 exportMethods(valueOf)
@@ -59,12 +60,15 @@ importFrom(checkmate,check_numeric)
 importFrom(checkmate,qassert)
 importFrom(checkmate,qtest)
 importFrom(methods,callNextMethod)
+importFrom(methods,classLabel)
 importFrom(methods,new)
 importFrom(methods,setClass)
 importFrom(methods,setGeneric)
 importFrom(methods,setMethod)
 importFrom(methods,setValidity)
+importFrom(methods,show)
 importFrom(methods,validObject)
 importFrom(stats,integrate)
 importFrom(stats,pgamma)
+importFrom(utils,capture.output)
 useDynLib(rmo, .registration = TRUE)

NEWS.md

@@ -2,6 +2,7 @@
 
 - Fix implementation of initializers and validity methods. In particular, `validObject` can now
   be called with the argument `test = TRUE` without causing an error. 
+- Add show method for  `BernsteinFunction`-classes.
 
 # rmo 0.5.2
 

R/allClass-S4.R

@@ -1,5 +1,5 @@
 #' @importFrom methods new setClass setValidity setGeneric setMethod validObject
-#'    callNextMethod
+#'    callNextMethod show classLabel
 NULL
 
 #' Virtual Class \code{BernsteinFunction} for Bernstein Functions

R/allShow-S4.R

@@ -0,0 +1,192 @@
+#' @importFrom utils capture.output
+#' @include allClass-S4.R
+NULL
+
+#' @describeIn LinearBernsteinFunction-class Display the object.
+#' @aliases show,LinearBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "LinearBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- scale: %s\n", format(object@scale)))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn ConstantBernsteinFunction-class Display the object.
+#' @aliases show,ConstantBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "ConstantBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- constant: %s\n", format(object@constant)))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn ScaledBernsteinFunction-class Display the object.
+#' @aliases show,ScaledBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "ScaledBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- scale: %s\n", format(object@scale)))
+      cat("- original:\n")
+      writeLines(
+        paste0("\t", capture.output(show(object@original))))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn SumOfBernsteinFunctions-class Display the object.
+#' @aliases show,SumOfBernsteinFunctions-method
+#'
+#' @export
+setMethod("show", "SumOfBernsteinFunctions",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat("- first:\n")
+      writeLines(
+        paste0("\t", capture.output(show(object@first))))
+      cat("- second:\n")
+      writeLines(
+        paste0("\t", capture.output(show(object@second))))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn CompositeScaledBernsteinFunction-class Display the object.
+#' @aliases show,CompositeScaledBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "CompositeScaledBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- cscale: %s\n", format(object@cscale)))
+      cat("- original:\n")
+      writeLines(
+        paste0("\t", capture.output(show(object@original))))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn PoissonBernsteinFunction-class Display the object.
+#' @aliases show,PoissonBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "PoissonBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- lambda: %s\n", format(object@lambda)))
+      cat(sprintf("- eta: %s\n", format(object@eta)))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn AlphaStableBernsteinFunction-class Display the object.
+#' @aliases show,AlphaStableBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "AlphaStableBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- alpha: %s\n", format(object@alpha)))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn InverseGaussianBernsteinFunction-class Display the object.
+#' @aliases show,InverseGaussianBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "InverseGaussianBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- eta: %s\n", format(object@eta)))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn ExponentialBernsteinFunction-class Display the object.
+#' @aliases show,ExponentialBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "ExponentialBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- lambda: %s\n", format(object@lambda)))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn GammaBernsteinFunction-class Display the object.
+#' @aliases show,GammaBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "GammaBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- a: %s\n", format(object@a)))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })
+
+#' @describeIn ParetoBernsteinFunction-class Display the object.
+#' @aliases show,ParetoBernsteinFunction-method
+#'
+#' @export
+setMethod("show", "ParetoBernsteinFunction",
+  function(object) {
+    cat(sprintf("An object of class %s\n", classLabel(class(object))))
+    if (isTRUE(validObject(object, test = TRUE))) {
+      cat(sprintf("- alpha: %s\n", format(object@alpha)))
+      cat(sprintf("- x0: %s\n", format(object@x0)))
+    } else {
+      cat("\t (invalid or not initialized)\n")
+    }
+
+    invisible(NULL)
+  })