-
Notifications
You must be signed in to change notification settings - Fork 13
/
segment.R
145 lines (133 loc) · 3.85 KB
/
segment.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
#' Vector of segments
#'
#' A segment is a finite directed line going from one point to another. If the
#' two points are equal it is considered to be [degenerate][is_degenerate]. A
#' segment can be flipped be taking its negative.
#'
#' @param ... Various input. See the Constructor section.
#' @param default_dim The dimensionality when constructing an empty vector
#' @param x A vector of segments or an object to convert to it
#'
#' @return An `euclid_segment` vector
#'
#' @section Constructors:
#' **2 and 3 dimensional segments**
#' - Providing two points will construct segments starting at the first point
#' and ending at the second
#' - Providing a point and a vector will construct segments starting at the
#' point and ending at the point defined by the start point plus the vector
#'
#' @export
#'
#' @family Geometries
#' @family Curves
#'
#' @examples
#' # Construction
#' p <- point(sample(4), sample(4))
#' s <- segment(p[1:2], p[3:4])
#' s
#'
#' plot(s)
#'
#' segment(p[1:2], as_vec(p[3:4]))
#'
#' # Flip segments
#' -s
#'
#' # Segments can be converted to vectors, directions and lines
#' as_vec(s)
#'
#' as_direction(s)
#'
#' as_line(s)
#' plot(s)
#' euclid_plot(as_line(s), lty = 2)
#'
segment <- function(..., default_dim = 2) {
inputs <- validate_constructor_input(...)
if (length(inputs) == 0) {
return(new_segment_empty(default_dim))
}
points <- inputs[vapply(inputs, is_point, logical(1))]
vectors <- inputs[vapply(inputs, is_vec, logical(1))]
if (length(points) == 2) {
new_segment_from_2_points(points[[1]], points[[2]])
} else if (length(points) == 1 && length(vectors) == 1) {
new_segment_from_point_vector(points[[1]], vectors[[1]])
} else {
abort("Can't construct a {.cls euclid_segment} vector from the given input")
}
}
#' @rdname segment
#' @export
is_segment <- function(x) inherits(x, "euclid_segment")
# Conversion --------------------------------------------------------------
#' @rdname segment
#' @export
as_segment <- function(x) {
UseMethod("as_segment")
}
#' @export
as_segment.default <- function(x) {
abort("Can't convert the input to a {.cls euclid_segment} vector")
}
#' @export
as_segment.euclid_segment <- function(x) x
#' @export
as_vec.euclid_segment <- function(x) {
vec(x)
}
#' @export
as_direction.euclid_segment <- function(x) {
direction(x)
}
#' @export
as_line.euclid_segment <- function(x) {
line(x)
}
# Operators ---------------------------------------------------------------
#' @export
geometry_op_minus.euclid_segment <- function(e1, e2) {
if (!missing(e2)) {
cli_abort("Segments cannot be subtracted, only negated")
}
if (dim(e1) == 2) {
restore_euclid_vector(segment_2_negate(get_ptr(e1)), e1)
} else {
restore_euclid_vector(segment_3_negate(get_ptr(e1)), e1)
}
}
# Misc --------------------------------------------------------------------
#' @export
seq.euclid_segment <- function(from, to, length.out = NULL, along.with = NULL, ...) {
if (dim(from) != dim(to)) {
cli_abort("{.arg from} and {.arg to} must have the same number of dimensions")
}
segment(
seq(vert(from, 1), vert(to, 1), length.out, along.with),
seq(vert(from, 2), vert(to, 2), length.out, along.with)
)
}
# Internal Constructors ---------------------------------------------------
new_segment_empty <- function(dim) {
if (dim == 2) {
new_geometry_vector(create_segment_2_empty())
} else {
new_geometry_vector(create_segment_3_empty())
}
}
new_segment_from_2_points <- function(p, q) {
if (dim(p) == 2) {
new_geometry_vector(create_segment_2_p_q(get_ptr(p), get_ptr(q)))
} else {
new_geometry_vector(create_segment_3_p_q(get_ptr(p), get_ptr(q)))
}
}
new_segment_from_point_vector <- function(p, v) {
if (dim(p) == 2) {
new_geometry_vector(create_segment_2_p_v(get_ptr(p), get_ptr(v)))
} else {
new_geometry_vector(create_segment_3_p_v(get_ptr(p), get_ptr(v)))
}
}