fix equations

NAMESPACE

@@ -16,6 +16,7 @@ export(ggdiagram)
 export(inside)
 export(intersection)
 export(intersection_angle)
+export(latex_color)
 export(map_ob)
 export(mean_color)
 export(midpoint)

R/a_early.R

@@ -218,8 +218,8 @@ method(`[<-`, has_style) <- function(x, y, value) {
       }
     }
   new_x <- rlang::inject(.fn(!!!d))
-  if (prop_exists(new_x, "corner_radius")) {
-    new_x@corner_radius <- x@corner_radius
+  if (prop_exists(new_x, "vertex_radius")) {
+    new_x@vertex_radius <- x@vertex_radius
   }
   new_x
 }
@@ -362,7 +362,7 @@ method(bind, class_list) <- function(x, ...) {
 
 
 method(bind, ob_shape_list) <- function(x, ...) {
-  .f <- lapply(x, S7::S7_class) %>% unique()
+  .f <- unique(lapply(x, S7::S7_class))
 
   csl <- lapply(.f, \(.ff) {
     Filter(f = \(xx){
@@ -372,8 +372,9 @@ method(bind, ob_shape_list) <- function(x, ...) {
   })
 
   if (length(csl) > 1) {
-    ob_shape_list(csl) %>%
-      `names<-`(purrr::map_chr(csl, \(xx) S7_class(xx)@name))
+    csl_names <- purrr::map_chr(csl, \(xx) S7_class(xx)@name)
+    ob_shape_list(csl) |>
+      `names<-`(csl_names)
 
   } else {
     csl[[1]]
@@ -1013,7 +1014,7 @@ prop_integer_coerce <- function(name) {
 as.geom <- new_generic("as.geom", "x")
 
 method(as.geom, ob_shape_list) <- function(x, ...) {
-  lapply(c(x), \(g) as.geom(g, ...)) %>%
+  lapply(c(x), \(g) as.geom(g, ...)) |>
     unlist()
 }
 
@@ -1304,3 +1305,4 @@ ggdiagram <- function(
     ggplot2::coord_equal(clip = "off") +
     ggplot2::theme(...)
 }
+

R/arcs.R

@@ -72,6 +72,9 @@ arc_props <- list(
     apothem = new_property(getter = function(self) {
       self@radius - self@sagitta
     }),
+    arc_length = new_property(getter = function(self) {
+      abs(self@radius) * abs(self@theta@radian)
+    }),
     sagitta = new_property(getter = function(self) {
       l <- self@chord@distance
       r <- self@radius
@@ -213,12 +216,7 @@ arc_props <- list(
         as.geom(self, ...)
       }
     }),
-    angle_at = new_property(class_function, getter = function(self) {
-      \(point) {
-        dp <- point - self@center
-        dp@theta
-      }
-    }),
+    angle_at = ob_circle@properties$angle_at,
     autolabel = new_property(class_function, getter = function(self) {
       \(label = as.character(degree(self@theta)),
         position = .5,
@@ -233,32 +231,19 @@ arc_props <- list(
       }
     }),
     midpoint = new_property(class_function, getter = function(self) {
-      \(position = .5, ...) midpoint(self, position = position, ...)
-    }),
-    point_at = new_property(
-      class_function,
-      getter = function(self) {
-        \(theta = degree(0), ...) ob_polar(theta = theta, r = self@radius, style = self@style, ...)
-      }
-    ),
-    tangent_at = new_property(
-      class = class_function,
-      getter = function(self) {
-        \(theta = degree(0), ...) {
-          x0 <- self@center@x
-          y0 <- self@center@y
-          x1 <- cos(theta) * self@radius + self@center@x
-          y1 <- cos(theta) * self@radius + self@center@y
-          ob_line(
-            a = x1 - x0,
-            b = y1 - y0,
-            c = x0^2 - (x1 * x0) + y0^2 - (y1 * y0) - self@radius^2,
-            style = self@style,
-            ...
-          )
-        }
+      \(position = .5, ...) {
+        m <- self@start@turn + (self@theta@turn * position)
+        self@center + ob_polar(
+          theta = turn(m),
+          r = self@radius,
+          style = self@style + ob_style(...))
       }
-    )
+
+    }),
+    normal_at = ob_circle@properties$normal_at,
+    place = pr_place,
+    point_at = ob_circle@properties$point_at,
+    tangent_at = ob_circle@properties$tangent_at
   ),
   # info ----
   info = list(aesthetics = new_property(
@@ -484,32 +469,19 @@ ob_arc <- new_class(
     }
 
     label <- centerpoint_label(label,
-                               center = center,
+                               center = label@p,
                                d = d,
                                shape_name = "ob_arc")
 
+    center = set_props(center, x = d$x0, y = d$y0)
+    center@style <- arc_style
 
 
-    if (S7_inherits(label, ob_label)) {
-      if (all(label@p@x == 0) && all(label@p@y == 0)) {
-        m <- start + ((end - start) * label@position)
-        label@p <- center + ob_polar(theta = m, r = radius)
-        if (all(length(label@hjust) == 0)) {
-          label@hjust <- polar2just(m, 1.4, axis = "h")
-        }
-
-        if (all(length(label@vjust) == 0)) {
-          label@vjust <- polar2just(m, 1.4, axis = "v")
-        }
 
 
 
-      }
 
-    }
 
-    center = set_props(center, x = d$x0, y = d$y0)
-    center@style <- arc_style
 
     if (S7_inherits(start, degree)) {
       start <- degree(d$start * 360)
@@ -527,9 +499,19 @@ ob_arc <- new_class(
       end <- turn(d$end)
     }
 
+    if (S7_inherits(label, ob_label)) {
+      if (all(label@p@x == 0) && all(label@p@y == 0)) {
+        m <- start + ((end - start) * label@position)
+        label@p <- center + ob_polar(theta = m, r = radius)
+        if (all(length(label@hjust) == 0)) {
+          label@hjust <- polar2just(m, 1.4, axis = "h")
+        }
 
-
-
+        if (all(length(label@vjust) == 0)) {
+          label@vjust <- polar2just(m, 1.4, axis = "v")
+        }
+      }
+    }
 
     new_object(
       centerpoint(center = center, label = label),
@@ -651,15 +633,10 @@ method(get_tibble_defaults, ob_arc) <- function(x) {
   get_tibble_defaults_helper(x, sp,required_aes = c("x0", "y0", "r", "start", "end", "group"))
 }
 
-method(
-  midpoint,
-  list(ob_arc, class_missing)) <- function(x,y, position = .5, ...) {
-  m <- x@start@turn + (x@theta@turn * position)
-  x@center + ob_polar(
-    theta = turn(m),
-    r = x@radius,
-    style = x@style + ob_style(...))
-  }
+method(midpoint,list(ob_arc, class_missing)) <- function(x,y, position = .5, ...) {
+    x@midpoint(position = position, ...)
+}
+
 
 method(`[`, ob_arc) <- function(x, y) {
   d <- as.list(x@tibble[y,] |>

R/bezier.R

@@ -225,9 +225,9 @@ ob_bezier <- new_class(
 
     if (S7_inherits(p, ob_point)) p <- list(p)
     p_style <- purrr::map(p, \(x) {
-      purrr::map(unbind(x), \(xx) xx@style) %>%
+      purrr::map(unbind(x), \(xx) xx@style) |>
         purrr::reduce(`+`)
-    }) %>%
+    }) |>
       bind()
 
 bz_style <- p_style + style +
@@ -460,9 +460,9 @@ method(as.geom, ob_bezier) <- function(x, ...) {
 
 method(`[`, ob_bezier) <- function(x, y) {
   d <- x@tibble[y,]
-  dl <- d %>%
-    dplyr::select(-.data$x, -.data$y, -.data$group) %>%
-    unique() %>%
+  dl <- d |>
+    dplyr::select(-.data$x, -.data$y, -.data$group) |>
+    unique() |>
     unbind()
   z <- rlang::inject(ob_bezier(p = x@p[y], !!!dl))
   z@label <- x@label[y]
@@ -474,6 +474,6 @@ method(midpoint, list(ob_bezier, class_missing)) <- function(x,y, position = .5,
 
   purrr::map(x@p, \(xx) {
     ob_point(bezier::bezier(t = position, p = xx@xy), ...)
-    }) %>%
+    }) |>
     bind()
 }

R/circles.R

@@ -114,6 +114,7 @@ cr_props <- list(
         }
       }
     ),
+    place = pr_place,
     point_at = new_property(
       class_function,
       getter = function(self) {

R/colors.R

@@ -40,8 +40,8 @@ class_color <- new_class(
       class = class_function,
       getter = function(self) {
         \(amount = 0.2) {
-          tibble::tibble(amount = amount, x = c(self)) %>%
-            purrr::pmap_chr(tinter::lighten) %>%
+          tibble::tibble(amount = amount, x = c(self)) |>
+            purrr::pmap_chr(tinter::lighten) |>
             class_color()
         }
       }
@@ -50,8 +50,8 @@ class_color <- new_class(
       class = class_function,
       getter = function(self) {
         \(amount = 0.2) {
-          tibble::tibble(amount = amount, x = c(self)) %>%
-            purrr::pmap_chr(tinter::darken) %>%
+          tibble::tibble(amount = amount, x = c(self)) |>
+            purrr::pmap_chr(tinter::darken) |>
             class_color()
         }
       }
@@ -114,7 +114,10 @@ class_color <- new_class(
         )
         self
       }
-    )
+    ),
+    tex = new_property(getter = function(self) {
+      paste0("\\color[HTML]{", substring(self@color, 2, 7), "}")
+    })
   ), constructor = function(color = class_missing, hue = NULL, saturation = NULL, brightness = NULL, alpha = NULL) {
     decoded <- farver::decode_colour(color, alpha = TRUE)
 
@@ -171,3 +174,22 @@ method(mean, class_color) <- function(x, ...) {
 mean_color <- function(x) {
   grDevices::colorRampPalette(x, space = "Lab")(3)[2]
 }
+
+# latex_color ----
+#' Surround TeX expression with a color command
+#'
+#' @param x TeX expression
+#' @param color color
+#'
+#' @return character string
+#' @export
+#'
+#' @examples
+#' latex_color("X^2", "red")
+latex_color <- function(x, color) {
+  if (!S7_inherits(color, class_color)) {
+    color <- class_color(color)
+  }
+  paste0("{",color@tex," ", x,"}")
+}
+

R/ellipses.R

@@ -87,6 +87,24 @@ el_props <- list(
       lamba <- (self@a - self@b) / ab
       pi * ab * (1 + (3 * lamba ^ 2) / (10 + sqrt(4 - 3 * lamba ^ 2)))
     }),
+    polygon = new_property(getter = function(self) {
+      d <- self@tibble
+      if (!("n" %in% colnames(d))) {
+        d$n <- 360
+      }
+
+
+
+      d$xy <- unbind(self) |>
+        purrr::map(\(x) {
+          if (length(x@n) > 0) n <- x@n else n <- 360
+          th <- degree(seq(0, 360, length.out = n + 1))
+          xy <- tibble::as_tibble(x@point_at(th)@xy) |>
+            dplyr::mutate(degree = th@degree)
+        })
+
+      tidyr::unnest(d, xy)
+    }),
     style = new_property(
       getter = function(self) {
         pr <- purrr::map(el_styles,
@@ -149,6 +167,7 @@ el_props <- list(
             distance / p1@r * rotate(p1, self@angle)
       }
     }),
+    place = pr_place,
     point_at = new_property(class_function, getter = function(self) {
       \(theta = degree(0), definitional = FALSE, ...) {
         if (!S7_inherits(theta, ob_angle)) theta <- degree(theta)