From 1b569d4de77f2a81f7dc6401814b3d150aedb924 Mon Sep 17 00:00:00 2001
From: Tobias Stephan <73840881+tobiste@users.noreply.github.com>
Date: Tue, 4 Jun 2024 18:50:25 -0400
Subject: [PATCH] started to introduce S4 classes

---
 .Rbuildignore              |   3 +-
 R/math.R                   |   2 -
 R/preliminary_S4_classes.R | 319 +++++++++++++++++++++++++++++++++++++
 man/classes.Rd             |  14 +-
 4 files changed, 328 insertions(+), 10 deletions(-)
 create mode 100644 R/preliminary_S4_classes.R

diff --git a/.Rbuildignore b/.Rbuildignore
index 0e0bf3d..ecad854 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -8,4 +8,5 @@
 ^R/density\.R$
 ^vignettes/Fault_displacements.Rmd
 ^data-raw$
-^R/mohr_shiny.R
\ No newline at end of file
+^R/mohr_shiny.R
+^R/preliminary_S4_classes.R
\ No newline at end of file
diff --git a/R/math.R b/R/math.R
index c9a259b..a420ecd 100644
--- a/R/math.R
+++ b/R/math.R
@@ -505,8 +505,6 @@ v_sd <- function(x, w = NULL) {
   sqrt(log(1 / Rbar^2))
 }
 
-
-
 #' @rdname stats
 #' @export
 v_delta <- function(x, w = NULL) {
diff --git a/R/preliminary_S4_classes.R b/R/preliminary_S4_classes.R
new file mode 100644
index 0000000..3919688
--- /dev/null
+++ b/R/preliminary_S4_classes.R
@@ -0,0 +1,319 @@
+# Class definition --------------------------------------------------------------
+
+setClass("Spherical")
+
+setClass("Line",
+         slots = c(
+           azimuth = "numeric",
+           plunge = "numeric"
+         ),
+         prototype = list(
+           azimuth = NA_real_,
+           plunge = NA_real_
+         ),
+         contains = "Spherical"
+)
+
+setClass("Plane",
+         slots = c(
+           dip_direction = "numeric",
+           dip = "numeric"
+         ),
+         prototype = list(
+           dip_direction = NA_real_,
+           dip = NA_real_
+         ),
+         contains = "Spherical"
+)
+
+setClass("Pair",
+         contains = c("Plane", "Line")
+)
+
+setClass("Fault",
+         contains = "Pair",
+         slots = c(
+           sense = "numeric"
+         ),
+         prototype = list(
+           sense = NA_real_
+         )
+)
+
+setClass("Vector",
+         slots = c(
+           X = "numeric",
+           Y = "numeric",
+           Z = "numeric"
+         ),
+         prototype = list(
+           X = NA_real_,
+           Y = NA_real_,
+           Z = NA_real_
+         )
+)
+
+### Examples -------------------------------------------------------------------
+
+l1 <- new("Line", azimuth = 120, plunge = 5)
+is(l1)
+
+
+# Validity tests ---------------------------------------------------------------
+
+setValidity("Line", function(object) {
+  if (length(object@azimuth) != length(object@plunge)) {
+    "@azimuth and @plunge must be same length"
+  } else {
+    TRUE
+  }
+})
+
+setValidity("Plane", function(object) {
+  if (length(object@dip_direction) != length(object@dip)) {
+    "@dip_direction and @dip must be same length"
+  } else {
+    TRUE
+  }
+})
+
+setValidity("Vector", function(object) {
+  ll <- list(object@X, object@Y, object@Z)
+  if (!all(sapply(ll, length) == length(ll[[1]]))) {
+    "@X, @Y and @Z must be same length"
+  } else {
+    TRUE
+  }
+})
+
+
+
+# Conversion functions ---------------------------------------------------------
+
+# fol2vec0 <- function(azi, inc) {
+#   azi <- tectonicr::deg2rad(azi)
+#   inc <- tectonicr::deg2rad(inc)
+#   cbind(
+#     x = -cos(azi) * sin(inc),
+#     y = -sin(azi) * sin(inc),
+#     z = cos(inc)
+#   )
+# }
+# 
+# lin2vec0 <- function(azi, inc) {
+#   azi <- tectonicr::deg2rad(azi)
+#   inc <- tectonicr::deg2rad(inc)
+#   cbind(
+#     x = cos(azi) * cos(inc),
+#     y = sin(azi) * cos(inc),
+#     z = sin(inc)
+#   )
+# }
+# 
+# vec2lin0 <- function(x, y, z) {
+#   n <- structr::vnorm(cbind(x, y, z)) # normalized vector
+#   nz <- sapply(n[, 3], function(x) ifelse(x < 0, -x, x))
+#   cbind(
+#     azimuth = tectonicr:::atan2d(n[, 2], n[, 1]) %% 360,
+#     plunge = tectonicr:::asind(nz)
+#   )
+# }
+# 
+# vec2fol0 <- function(x, y, z) {
+#   n <- structr::vnorm(cbind(x, y, z)) # normalized vector
+#   nz <- sapply(n[, 3], function(x) ifelse(x < 0, -x, x))
+#   cbind(
+#     dip_direction = (tectonicr:::atan2d(n[, 2], n[, 1]) + 180) %% 360,
+#     dip = 90 - tectonicr:::asind(nz)
+#   )
+# }
+
+Line <- function(x, plunge = NA) {
+  if (is(x, "Plane")) {
+    v <- fol2vec0(x@dip_direction, x@dip)
+    l <- vec2lin0(v[, "x"], v[, "y"], v[, "z"])
+    x <- l[, "azimuth"]
+    plunge <- l[, "plunge"]
+  } else if (is(x, "Vector")) {
+    p <- vec2lin0(x[, "x"], x[, "y"], x[, "z"])
+    x <- l[, "azimuth"]
+    plunge <- l[, "plunge"]
+  }
+  azimuth <- as.double(x)
+  plunge <- as.double(plunge)
+  
+  new("Line", azimuth = azimuth, plunge = plunge)
+}
+
+
+Plane <- function(x, dip = NA) {
+  if(is(x, "Pair")){
+    x = x@dip_direction
+    dip = x@dip
+  }
+  if (is(x, "Line")) {
+    v <- lin2vec0(x@azimuth, x@plunge)
+    p <- vec2fol0(v[, "x"], v[, "y"], v[, "z"])
+    x <- p[, "dip_direction"]
+    dip <- p[, "dip"]
+  } else if (is(x, "Vector")) {
+    p <- vec2lin0(x[, "x"], x[, "y"], x[, "z"])
+    x <- l[, "dip_direction"]
+    dip <- l[, "dip"]
+  }
+  dip_direction <- as.double(x)
+  dip <- as.double(dip)
+  
+  new("Plane", dip_direction = dip_direction, dip = dip)
+}
+
+
+Vector <- function(x, y, z) {
+  if (is(x, "Spherical")) {
+    if (is(x, "Line")) {
+      v <- lin2vec0(x@azimuth, x@plunge)
+    } else if (is(x, "Plane")) {
+      v <- fol2vec0(x@dip_direction, x@dip)
+    }
+    x <- v[, "x"]
+    y <- v[, "y"]
+    z <- v[, "z"]
+  }
+  x <- as.double(x)
+  y <- as.double(y)
+  z <- as.double(z)
+  
+  new("Vector", X = x, Y = y, Z = z)
+}
+
+
+Pair <- function(x, y = NA, azimuth = NA, plunge = NA) {
+  if(is(x, "Pair")){
+    dip_direction = x@dip_direction
+    dip = x@dip
+    azimuth <- x@azimuth
+    plunge <- x@plunge
+  }
+  else if(is(x, "Plane") & is(y, "Line")){
+    dip_direction = x@dip_direction
+    dip = x@dip
+    
+    azimuth = y@azimuth
+    plunge = y@plunge
+    
+  } else {
+    dip_direction <- as.double(x)
+    dip <- as.double(y)
+    azimuth <- as.double(azimuth)
+    plunge <- as.double(plunge)
+  }
+  
+  new("Pair", dip_direction = dip_direction, dip = dip, azimuth = azimuth, plunge = plunge)
+}
+
+Fault <- function(x, y = NA, azimuth = NA, plunge = NA, sense = NA) {
+  if(is(x, "Pair")){
+    dip_direction = x@dip_direction
+    dip = x@dip
+    azimuth <- x@azimuth
+    plunge <- x@plunge
+  }
+  else if(is(x, "Plane") & is(y, "Line")){
+    dip_direction = x@dip_direction
+    dip = x@dip
+    
+    azimuth = y@azimuth
+    plunge = y@plunge
+    
+  } else {
+    dip_direction <- as.double(x)
+    dip <- as.double(y)
+    azimuth <- as.double(azimuth)
+    plunge <- as.double(plunge)
+  }
+  sense <- sign(as.integer(sense))
+  
+  new("Fault", dip_direction = dip_direction, dip = dip, azimuth = azimuth, plunge = plunge, sense = sense)
+}
+
+
+
+
+
+### Examples -------------------------------------------------------------------
+
+Vector(1, 0, 0)
+l1 <- Line(120, 5)
+l1 |> Vector()
+p1 <- Plane(130, 10) 
+p1 |> Line()
+
+Pair(p1, l1)
+
+Fault(p1, l1, -1)
+
+# Generic Functions ------------------------------------------------------------
+ l2 <- Line(c(120, 130), c(5, NA))
+
+## extract columns -------------------------------------------------------------
+
+setGeneric("azimuth", function(x) standardGeneric("azimuth"))
+setGeneric("azimuth<-", function(x, value) standardGeneric("azimuth<-"))
+setMethod("azimuth", "Line", function(x) x@azimuth)
+setMethod("azimuth<-", "Line", function(x, value) {
+  x@azimuth <- value
+  x
+})
+
+setGeneric("plunge", function(x) standardGeneric("plunge"))
+setGeneric("plunge<-", function(x, value) standardGeneric("plunge<-"))
+setMethod("plunge", "Line", function(x) x@plunge)
+setMethod("plunge<-", "Line", function(x, value) {
+  x@plunge <- value
+  x
+})
+
+setGeneric("dip_direction", function(x) standardGeneric("dip_direction"))
+setGeneric("dip_direction<-", function(x, value) standardGeneric("dip_direction<-"))
+setMethod("dip_direction", "Plane", function(x) x@dip_direction)
+setMethod("dip_direction<-", "Plane", function(x, value) {
+  x@dip_direction <- value
+  x
+})
+
+setGeneric("dip", function(x) standardGeneric("dip"))
+setGeneric("dip<-", function(x, value) standardGeneric("dip<-"))
+setMethod("dip", "Plane", function(x) x@dip)
+setMethod("dip<-", "Plane", function(x, value) {
+  x@dip <- value
+  x
+})
+
+setGeneric("sense", function(x) standardGeneric("sense"))
+setGeneric("sense<-", function(x, value) standardGeneric("sense<-"))
+setMethod("sense", "Fault", function(x) x@sense)
+setMethod("sense<-", "Fault", function(x, value) {
+  x@sense <- value
+  x
+})
+
+### Examples -------------------------------------------------------------------
+
+azimuth(l1)
+azimuth(l2)
+
+
+
+
+
+## Length ----------------------------------------------------------------------
+setGeneric("myGeneric", function(x) standardGeneric("myGeneric"))
+
+length(l2)
+
+## Mean ------------------------------------------------------------------------
+
+
+## Plot ------------------------------------------------------------------------
+
+
diff --git a/man/classes.Rd b/man/classes.Rd
index a5d2044..3bdd592 100644
--- a/man/classes.Rd
+++ b/man/classes.Rd
@@ -17,13 +17,13 @@
 \alias{is.spherical}
 \title{Structure classes}
 \usage{
-Line(azimuth, plunge)
+Line(x, plunge = NA)
 
-Plane(dip_direction, dip)
+Plane(x, dip = NA)
 
-Fault(dip_direction, dip, azimuth, plunge, sense = NULL)
+Fault(x, y = NA, azimuth = NA, plunge = NA, sense = NA)
 
-Pair(dip_direction, dip, azimuth, plunge)
+Pair(x, y = NA, azimuth = NA, plunge = NA)
 
 as.line(l)
 
@@ -47,15 +47,15 @@ is.spherical(l)
 \item{azimuth, plunge}{numeric vectors. Azimuth and plunge of a line (in
 degrees)}
 
-\item{dip_direction, dip}{numeric vectors. Dip direction and dip of a plane
-(in degrees)}
-
 \item{sense}{(optional) integer. Sense of the line on a fault plane. Either
 \code{1}or \code{-1} for normal or thrust offset, respectively.}
 
 \item{l, p, f}{numeric vector or array containing the spherical coordinates
 (1st element/column is azimuth, 2nd element/column is inclination, both in
 degrees), or object of class \code{"line"}, \code{"plane"}, \code{"pair"}, or \code{"fault"}}
+
+\item{dip_direction, dip}{numeric vectors. Dip direction and dip of a plane
+(in degrees)}
 }
 \description{
 \code{Line}, \code{Plane}, and \code{Fault} create a \code{"line"}, \code{"plane"}, \code{"pair"}, and \code{"fault"}