alter obj model

I was using attributes for some items, but I don't think very many users
know how to work with attributes, so I switched to use a list instead.
Thus, users can now write

    m@attributes$converged

instead of

    attr(m, "converged")

PS. this is mainly for advanced users, or package developers.  I suspect
that most users will be digging this far down into the object structure.

R/anchor.R

@@ -31,9 +31,9 @@
 #'
 #' @author Dan Kelley
 anchor <- function(model = "1 Railway Wheel", buoyancy = NULL, height = NULL, CD = NULL) {
-    #message("about to try anchorS7...")
-    #print(anchorS7())
-    #message("... did it work?")
+    # message("about to try anchorS7...")
+    # print(anchorS7())
+    # message("... did it work?")
     data("mooringElements", package = "mooring", envir = environment())
     mooringElements <- get("mooringElements")
     if (model == "?") {
@@ -67,16 +67,15 @@ anchor <- function(model = "1 Railway Wheel", buoyancy = NULL, height = NULL, CD
 
 #' Find Anchor Weight of a Mooring
 #'
-#' @param m an object of class `"mooring"`, created with [mooring()].
+#' @template mTemplate
 #'
-#' @return `anchorWeight` returns the weight (i.e. the negative of the
-#' buoyancy) of the anchor in the mooring.
+#' @return `anchorWeight` returns the weight of the mooring anchor,
+#' in kg.
 #'
 #' @export
 #'
 #' @author Dan Kelley
-anchorWeight <- function(m)
-{
+anchorWeight <- function(m) {
     if (!is.mooring(m)) {
         stop("m must be a mooring object, created with mooring()")
     }

R/app2bs.R

@@ -404,7 +404,7 @@ app2bs <- function(debug = FALSE) {
                         "exp(-depth/300)" = function(depth) input$u * exp(-depth / 300)
                     )
                     msk <- knockdown(ms, u, debug = debug)
-                    attr <- attributes(msk)
+                    diagnostics <- msk@diagnostics
                     mar <- c(0.5, 2.5, 3.75, 0.5)
                     mgp <- c(1.5, 0.5, 0)
                     cex <- 1.2
@@ -437,14 +437,14 @@ app2bs <- function(debug = FALSE) {
                         if (!titleShown) {
                             mtext(
                                 sprintf(
-                                    if (attr$converged) {
+                                    if (diagnostics$converged) {
                                         "Converged to %.03fm and %.02fdeg in %s"
                                     } else {
                                         "Not yet converged (%.03fm and %.02fdeg in %s)"
                                     },
-                                    attr$RMSDepthChange,
-                                    attr$RMSAngleChange,
-                                    pluralize("iteration", n = attr$iteration)
+                                    diagnostics$RMSDepthChange,
+                                    diagnostics$RMSAngleChange,
+                                    pluralize("iteration", n = diagnostics$iteration)
                                 ),
                                 cex = par("cex"),
                                 col = 2,

R/knockdown.R

@@ -13,7 +13,7 @@
 #' Examples 2 and 3.
 #'
 #' @param m an object of the `"mooring"` class, usually created with
-#' [segmentize()].
+#' [mooring()], followed by a call to [segmentize()].
 #'
 #' @template uTemplate
 #'
@@ -200,9 +200,19 @@ knockdown <- function(m, u = 1, convergence = 0.1, maxiteration = 100, debug = 0
         ))
     }
     m@u <- u
-    attr(m, "iteration") <- iterationCount
-    attr(m, "RMSAngleChange") <- 180 / pi * RMSAngleChange
-    attr(m, "RMSDepthChange") <- RMSDepthChange
-    attr(m, "converged") <- iterationCount < maxiteration
+    insufficientBuoyancy <- max(depth(m)) > waterDepth
+    #attr(m, "iteration") <- iterationCount
+    #attr(m, "RMSAngleChange") <- 180 / pi * RMSAngleChange
+    #attr(m, "RMSDepthChange") <- RMSDepthChange
+    #attr(m, "converged") <- iterationCount < maxiteration
+    #attr(m, "insufficientBuoyancy") <- insufficientBuoyancy
+    m@attributes$iteration <- iterationCount
+    m@attributes$RMSAngleChange <- 180 / pi * RMSAngleChange
+    m@attributes$RMSDepthChange <- RMSDepthChange
+    m@attributes$converged <- iterationCount < maxiteration
+    m@attributes$insufficientBuoyancy <- insufficientBuoyancy
+    if (insufficientBuoyancy) {
+        warning("More buoyancy is needed to lift all mooring elements off the bottom")
+    }
     m
 } # knockdown()

R/oo.R

@@ -4,7 +4,8 @@ mooringS7 <- S7::new_class("mooringS7",
     properties = list(
         elements = class_list, # holds mooringElement items
         waterDepth = class_numeric,
-        u = class_any
+        u = class_any,
+        attributes = class_list
     ),
     validator = function(self) {
         NULL
@@ -15,7 +16,10 @@ mooringS7 <- S7::new_class("mooringS7",
         # cat("elements[[1]] follows\n");print(elements[[1]])
         if (!is.anchor(elements[[1]])) stop("element 1 is not an anchor")
         if (is.na(waterDepth)) stop("must specify waterDepth")
-        new_object(S7_object(), elements = elements, waterDepth = waterDepth, u = 0.0)
+        new_object(S7_object(),
+            elements = elements, waterDepth = waterDepth, u = 0.0,
+            attributes = list()
+        )
     }
 )
 
@@ -273,7 +277,7 @@ S7::method(`plot`, mooring:::mooringS7) <- function(
     # message("plot 15")
     # draw anchor (only makes sense for shape diagrams)
     if (which == "shape") {
-        waterDepth <- attr(m, "waterDepth")
+        waterDepth <- m@waterDepth
         n <- length(m@elements)
         A <- m@elements[[n]]@height
         anchorSymbol <- list(x = sqrt(3.0 / 4.0) * c(-A, 0, A), y = waterDepth - c(0, A, 0))
@@ -403,6 +407,11 @@ S7::method(`plot`, mooring:::mooringS7) <- function(
         }
     }
     mtext(title, side = 1, cex = par("cex"))
+    if (isTRUE(m@attributes$insufficientBuoyancy)) {
+        mtext("mooring needs more buoyancy",
+            side = 3, line = -1, cex = 1.1 * par("cex"), col = 2
+        )
+    }
     mooringDebug(debug, "} # plot()\n", sep = "")
 }
 
@@ -435,16 +444,16 @@ S7::method(`summary`, mooring:::mooringS7) <- function(
         stop("internal programming error: how did an element call this?")
     }
     n <- length(x@elements)
-    if (is.null(attr(x, "segmentized"))) {
+    if (!isTRUE(x@attributes$segmentized)) {
         cat(sprintf(
             "Mooring in %gm of water that has %d elements, listed from the top down:\n",
             x@waterDepth, n
         ))
     } else {
-        if (is.null(attr(x, "u"))) {
+        if (is.null(x@u)) {
             cat("Segmentized mooring with", n, "elements, listed from the top down:\n")
         } else {
-            cat("Segmentized a knocked-over mooring with", n, "elements, listed from the top down:\n")
+            cat("Segmentized knocked-over mooring with", n, "elements, listed from the top down:\n")
         }
     }
     prefix <- "  "

docs/pkgdown.yml

@@ -8,5 +8,5 @@ articles:
   mooring: mooring.html
   object_orientation: object_orientation.html
   table_tennis: table_tennis.html
-last_built: 2024-06-11T11:57Z
+last_built: 2024-06-11T17:31Z