balebrun_plot grid updated; stereoplot's N is now a text at a specified position instead of mtext

Author: tobiste

R/fabric_plots.R

@@ -330,13 +330,13 @@ vollmer_plot.list <- function(x, labels = NULL, add = FALSE, ngrid = c(5, 5, 5),
 #' balebrun_plot(Pair_from_pitch(Plane(0, 80), 10), "strike-slip", col = 2, add = TRUE)
 #' balebrun_plot(Pair_from_pitch(Plane(0, 10), 10), "horizontal flow", col = 3, add = TRUE)
 balebrun_plot <- function(x, labels = NULL, main = "Dip-Pitch-Plunge Diagram", extra_labels = TRUE, add = FALSE, ...) {
-  stopifnot(is.Pair(x))
   # plunge <- x[, "plunge"]
-  pitch <- Pair_pitch(x)
-  dip <- x[, "dip"]
-
-  crds <- .ternary_from_pitchdip(pitch, dip)
-
+  # pitch <- Pair_pitch(x)
+  # dip <- x[, "dip"]
+  # 
+  # crds <- .ternary_from_pitchdip(pitch, dip)
+  crds <- .balebrun_coords(x)
+  
 
   if (isFALSE(add)) {
     .ternary_plot(
@@ -380,6 +380,14 @@ balebrun_plot <- function(x, labels = NULL, main = "Dip-Pitch-Plunge Diagram", e
   invisible(crds)
 }
 
+.balebrun_coords <- function(x){
+  stopifnot(is.Pair(x))
+  pitch <- Pair_pitch(x)
+  dip <- x[, "dip"]
+  .ternary_from_pitchdip(pitch, dip)
+}
+  
+
 .ternary_from_pitchdip <- function(pitch, dip) {
   plunge <- plunge_from_pitchdip(pitch = pitch, dip = dip)
 
@@ -424,13 +432,43 @@ balebrun_plot <- function(x, labels = NULL, main = "Dip-Pitch-Plunge Diagram", e
   }
 
   # --- Constant pitch lines (pitch fixed, dip varies) ---
-  dip_corner <- cbind(1, 0)
+  # dip_corner <- cbind(1, 0)
+  # pitch_seq_s <- sort(pitch_seq)
+  # pitch_seq_sr <- pitch_seq_s[-c(1L, length(pitch_seq_s))] # remove first and last line 
+  # 
+  # pitch_lines_sr <- .ternary_from_pitchdip(pitch_seq_sr, dip = 90)
+  # graphics::segments(x0 = dip_corner[, 1], y0 = dip_corner[, 2], x1 = pitch_lines_sr[, 1], y1 = pitch_lines_sr[, 2], col = col, lty = lty, ...)
+
   pitch_seq_s <- sort(pitch_seq)
   pitch_seq_sr <- pitch_seq_s[-c(1L, length(pitch_seq_s))] # remove first and last line 
 
-  pitch_lines_sr <- .ternary_from_pitchdip(pitch_seq_sr, dip = 90)
-  graphics::segments(x0 = dip_corner[, 1], y0 = dip_corner[, 2], x1 = pitch_lines_sr[, 1], y1 = pitch_lines_sr[, 2], col = col, lty = lty, ...)
-
+  dip_seq2 <- seq(min(dip_seq), max(dip_seq), length.out = n_interp)
+  dip_seq2 <- dip_seq2[-c(1L, length(dip_seq2))] # remove first and last line 
+  
+  invisible(lapply(pitch_seq_sr, function(p){
+    pitch_lines_sr <- t(vapply(dip_seq2, function(d){
+      pitch_lines_sr <- .ternary_from_pitchdip(p, dip = d)
+    }, numeric(2)))
+    graphics::lines(pitch_lines_sr[, 1], pitch_lines_sr[, 2], col = col, lty = lty)
+    
+  })
+  )
+  
+  plunge_seq_s <- sort(plunge_seq)
+  plunge_seq_sr <- plunge_seq_s[-c(1L, length(plunge_seq_s))] # remove first and last line 
+
+ 
+  invisible(lapply(pitch_seq, function(pl){
+    crds <- t(vapply(pitch_seq, function(pi){
+      di <- dip_from_pitchplunge(pi, pl)
+      .ternary_from_pitchdip(pi, di)
+    }, numeric(2))
+    )
+    lines(crds[, 1], crds[, 2], col = col, lty = lty)
+  }))
+  
+  
+  
   # --- Constant plunge lines ---
   # plunge_seq_s <- sort(plunge_seq)
   # plunge_seq_sr <- plunge_seq_s[-c(1L, length(plunge_seq_s))] # remove first and last line 
@@ -458,6 +496,12 @@ balebrun_plot <- function(x, labels = NULL, main = "Dip-Pitch-Plunge Diagram", e
 
     graphics::text(dip_seq/90, 0, rev(dip_seq), pos = 1, cex = 0.8) # dip 
   }
+  
+  A <- c(0, 0) # left
+  B <- c(1, 0) # right
+  C <- c(1 / 2, sqrt(3) / 2) # top
+  abc <- rbind(A, B, C)
+  graphics::polygon(abc)
 }
 
 #' Fabric Plot of Woodcock (1977)

R/stereonet_base.R

@@ -476,31 +476,31 @@ stereoplot_frame <- function(n = 512L, radius = 1, ...) {
 }
 
 
-#' Stereographic Projection
+#' Stereographic and Equal Area Projection
 #'
-#' Initialize the plot for equal-area stereographic projections (Wulff) or Lambert
-#' Equal-Area projections (Schmidt).
+#' Initialize the plot for equal-angle stereographic projections (Wulff) or Lambert
+#' equal-area projections (Schmidt).
 #'
 #' @param earea logical. Projection, either `TRUE` for Lambert equal-area
 #' projection (the default), or `FALSE` for meridional stereographic projection.
 #' @param guides logical. Whether guides should be added to the plot (`TRUE` by default)
 #' @param d integer. Angle distance between guides. Default: 10
-#' @param col color of guide lines
-#' @param lwd linewidth of guide lines
-#' @param lty linetype of guide lines
+#' @param col Color of guide lines
+#' @param lwd Width of guide lines
+#' @param lty Type of guide lines
 #' @param border.col color of primitive circle (frame), center-cross and ticks of the stereo plot
 #' @param centercross logical. Whether a center cross should be added (`TRUE` by default)
 #' @param ticks integer. Angle between ticks. if `NULL` (the default), no ticks are drawn.
 #' @param title,sub character. Title and subtitle of plot
-#' @param origin.text character. Text at origin of stereoplot.
+#' @param origin.text character. Text at origin of plot
 #' @param labels this can either be a logical value specifying whether (numerical)
-#' annotations are to be made next to the tickmarks, or a character or expression
-#' vector of labels to be placed next to the tickpoints.
-#' @param ladj adjustment for all labels away from origin of stereoplot circle.
+#' annotations are to be made next to the tick marks, or a character or expression
+#' vector of labels to be placed next to the tick points.
+#' @param ladj adjustment for all labels away from origin of projection circle.
 #' This essentially an amount that is added to `radius` and the length of the ticks.
 #' @param radius numeric. Radius of circle
 #' @param center An object of class `"Vec3"`, `"Line"`, `"Ray"`, or `"Plane"`
-#' specifying the center of the stereoplot. If `NULL` (the default), the center
+#' specifying the center of the projection If `NULL` (the default), the center
 #' is at the origin of the plot.
 #'
 #' @source Adapted from the `RFOC` package
@@ -526,13 +526,15 @@ stereoplot <- function(earea = TRUE, guides = TRUE, d = 10, col = "gray90",
   )
 
   graphics::title(main = title, sub = sub)
-  graphics::mtext(origin.text, col = border.col, font = 2)
+  # graphics::mtext(origin.text, col = border.col, font = 2)
+  
+  graphics::text(0, (3*ladj) + radius, label = "N", col = border.col, font = 2)
 
   if (guides) stereoplot_guides(d = d, earea = earea, col = col, lwd = lwd, lty = lty, radius = radius, center = center)
 
   if (!is.null(ticks)) stereoplot_ticks(angle = ticks, col = border.col, radius = radius, labels = labels, ladj = ladj)
 
-  if (centercross) points(0, 0, pch = 3, col = border.col)
+  if (centercross) graphics::points(0, 0, pch = 3, col = border.col)
 
   stereoplot_frame(col = border.col, radius = radius)
 }