Skip to content

Commit

Permalink
Implemented zebra style for yardstick
Browse files Browse the repository at this point in the history
  • Loading branch information
@baddstats
baddstats committed Feb 19, 2025
1 parent 95599a9 commit a6eac41
Show file tree
Hide file tree
Showing 6 changed files with 135 additions and 42 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: spatstat.geom
Version: 3.3-5.001
Date: 2025-02-18
Version: 3.3-5.002
Date: 2025-02-19
Title: Geometrical Functionality of the 'spatstat' Family
Authors@R: c(person("Adrian", "Baddeley",
role = c("aut", "cre", "cph"),
Expand Down
9 changes: 8 additions & 1 deletion NEWS
View file
Original file line number Diff line number Diff line change
@@ -1,11 +1,18 @@
CHANGES IN spatstat.geom VERSION 3.3-5.001
CHANGES IN spatstat.geom VERSION 3.3-5.002

OVERVIEW

o Minor improvements.

SIGNIFICANT USER-VISIBLE CHANGES

o plot.yardstick
New argument 'style' allows different styles of plotting a scale bar
including a zebra pattern (style = "zebra").

o plot.yardstick
New arguments 'zebra.step', 'zebra.width', 'zebra.col'.

o as.mask
Corrected a warning message.

Expand Down
105 changes: 79 additions & 26 deletions R/diagram.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
## Simple objects for the elements of a diagram (text, arrows etc)
## that are compatible with plot.layered and plot.solist
##
## $Revision: 1.18 $ $Date: 2024/06/16 02:03:14 $
## $Revision: 1.19 $ $Date: 2025/02/19 07:13:33 $

# ......... internal class 'diagramobj' supports other classes .........

Expand Down Expand Up @@ -175,47 +175,99 @@ plot.yardstick <- local({
}

plot.yardstick <- function(x, ...,
style=c("arrows", "zebra"),
angle=20,
frac=1/8,
split=FALSE,
shrink=1/4,
zebra.step=NULL,
zebra.width=NULL,
zebra.col="black",
pos=NULL,
txt.args=list(),
txt.shift=c(0,0),
do.plot=TRUE) {
style <- match.arg(style)
if(do.plot) {
txt <- attr(x, "txt")
argh <- resolve.defaults(list(...), attr(x, "otherargs"))
A <- as.numeric(coords(x)[1L,])
B <- as.numeric(coords(x)[2L,])
M <- (A+B)/2
if(!split) {
## double-headed arrow
myarrows(A[1L], A[2L], B[1L], y1=B[2L],
angle=angle, frac=frac, moreargs=argh)
if(is.null(pos) && !("adj" %in% names(txt.args)))
pos <- if(abs(A[1L] - B[1L]) < abs(A[2L] - B[2L])) 4 else 3
if(is.null(txt.shift)) {
txt.shift <- rep(0, 2)
} else {
## two single-headed arrows with text
dM <- (shrink/2) * (B - A)
AM <- M - dM
BM <- M + dM
newfrac <- frac/((1-shrink)/2)
myarrows(AM[1L], AM[2L], A[1L], A[2L],
angle=angle, frac=newfrac, left=FALSE, moreargs=argh)
myarrows(BM[1L], BM[2L], B[1L], B[2L],
angle=angle, frac=newfrac, left=FALSE, moreargs=argh)
txt.shift <- ensure2vector(unlist(txt.shift))
}
if(is.null(txt.shift)) txt.shift <- rep(0, 2) else
txt.shift <- ensure2vector(unlist(txt.shift))
do.call.matched(text.default,
resolve.defaults(list(x=M[1L] + txt.shift[1L],
y=M[2L] + txt.shift[2L]),
txt.args,
list(labels=txt, pos=pos),
argh,
.MatchNull=FALSE),
funargs=graphicsPars("text"))
switch(style,
arrows = {
if(!split) {
## double-headed arrow
myarrows(A[1L], A[2L], B[1L], y1=B[2L],
angle=angle, frac=frac, moreargs=argh)
if(is.null(pos) && !("adj" %in% names(txt.args)))
pos <- if(abs(A[1L] - B[1L]) < abs(A[2L] - B[2L])) 4 else 3
} else {
## two single-headed arrows with text
dM <- (shrink/2) * (B - A)
AM <- M - dM
BM <- M + dM
newfrac <- frac/((1-shrink)/2)
myarrows(AM[1L], AM[2L], A[1L], A[2L],
angle=angle, frac=newfrac, left=FALSE, moreargs=argh)
myarrows(BM[1L], BM[2L], B[1L], B[2L],
angle=angle, frac=newfrac, left=FALSE, moreargs=argh)
}
do.call.matched(text.default,
resolve.defaults(list(x=M[1L] + txt.shift[1L],
y=M[2L] + txt.shift[2L]),
txt.args,
list(labels=txt, pos=pos),
argh,
.MatchNull=FALSE),
funargs=graphicsPars("text"))
},
zebra = {
## total length and direction
D <- B-A
totlen <- sqrt(sum(D^2))
theta <- atan2(D[2L], D[1L])
## length and width of each bar
if(missing(zebra.step))
zebra.step <- totlen/5
if(missing(zebra.width))
zebra.width <- totlen/25
## construct rectangles, then shift + rotate
breaks <- seq(0, totlen, by=zebra.step)
if(breaks[length(breaks)] < totlen * 0.95)
breaks <- c(breaks, totlen)
yr <- zebra.width * c(-1,1)/2
filled <- TRUE
if(length(breaks) > 1) {
for(i in 2:length(breaks)) {
block <- owin(c(breaks[i-1], breaks[i]), yr)
block <- rotate(shift(block, A), angle=theta, centre=M)
if(filled) {
plot(block, add=TRUE, col=zebra.col)
} else {
plot(block, add=TRUE, border=zebra.col)
}
vb <- vertices(block)
x3 <- vb$x[3L]
y3 <- vb$y[3L]
do.call.matched(text.default,
resolve.defaults(list(x=x3 + txt.shift[1L],
y=y3 + txt.shift[2L]),
txt.args,
list(labels=breaks[i],
pos=pos),
argh,
.MatchNull=FALSE),
funargs=graphicsPars("text"))
filled <- !filled
}
}
})
}
return(invisible(Window(x)))
}
Expand All @@ -240,6 +292,7 @@ print.yardstick <- function(x, ...) {
return(invisible(NULL))
}

## ........... 'onearrow' ..............................................

## code to draw a decent-looking arrow in spatstat diagrams
## (works in layered objects)
Expand Down
2 changes: 1 addition & 1 deletion inst/doc/packagesizes.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,4 +30,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
"2024-07-09" "3.3-2" 442 1186 0 35638 15596
"2024-09-18" "3.3-3" 443 1187 0 35818 15596
"2024-11-18" "3.3-4" 444 1190 0 35978 15596
"2025-02-18" "3.3-5.001" 445 1191 0 36159 15596
"2025-02-19" "3.3-5.002" 445 1191 0 36212 15596
2 changes: 1 addition & 1 deletion inst/info/packagesizes.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,4 +30,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
"2024-07-09" "3.3-2" 442 1186 0 35638 15596
"2024-09-18" "3.3-3" 443 1187 0 35818 15596
"2024-11-18" "3.3-4" 444 1190 0 35978 15596
"2025-02-18" "3.3-5.001" 445 1191 0 36159 15596
"2025-02-19" "3.3-5.002" 445 1191 0 36212 15596
55 changes: 44 additions & 11 deletions man/plot.yardstick.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,10 @@
}
\usage{
\method{plot}{yardstick}(x, \dots,
style=c("arrows", "zebra"),
angle = 20, frac = 1/8,
split = FALSE, shrink = 1/4,
zebra.step=NULL, zebra.width=NULL, zebra.col="black",
pos = NULL,
txt.args=list(),
txt.shift=c(0,0),
Expand All @@ -24,21 +26,41 @@
Additional graphics arguments passed to
\code{\link[graphics]{segments}} to control the appearance of the line.
}
\item{style}{
Character string (partially matched) specifying the
style of plot. See Details.
}
\item{angle}{
Angle between the arrows and the line segment, in degrees.
Angle between the arrows and the line segment, in degrees.
Applies when \code{style="arrows"}.
}
\item{frac}{
Length of arrow as a fraction of total length of the line segment.
Applies when \code{style="arrows"}.
}
\item{split}{
Logical. If \code{TRUE}, then the line will be broken in the
middle, and the text will be placed in this gap. If \code{FALSE},
the line will be unbroken, and the text will be placed beside
the line.
Applies when \code{style="arrows"}.
}
\item{shrink}{
Fraction of total length to be removed from the middle of the
line segment, if \code{split=TRUE}.
Applies when \code{style="arrows"}.
}
\item{zebra.step}{
Length of each bar in the zebra pattern.
Applies when \code{style="zebra"}.
}
\item{zebra.width}{
Width of each bar in the zebra pattern.
Applies when \code{style="zebra"}.
}
\item{zebra.col}{
Colour of each bar in the zebra pattern.
Applies when \code{style="zebra"}.
}
\item{pos}{
Integer (passed to \code{\link[graphics]{text}}) determining the
Expand All @@ -63,10 +85,25 @@
}
\details{
A yardstick or scale bar is a line segment, drawn on any spatial
graphics display, indicating the scale of the plot.
graphics display, indicating the scale of the plot.

\itemize{
\item If \code{style="arrows"}, the line segment is drawn as a pair
of arrows pointing from the middle of the line to the ends of the
line. This style is often used in architectural drawings.
If \code{angle=0}, the arrow heads are replaced by parallel bars
marking the two ends of the line.
\item If \code{style="zebra"}, the line segment is divided into
block of length \code{zebra.step} and width \code{zebra.width}
units. Blocks are drawn alternately as filled rectangles and
outlined rectangles, so that the result resembles a zebra crossing.
This style is often used in maps and charts. There are sensible
defaults for \code{zebra.step} and \code{zebra.width}.
}

The argument \code{x} should be an object of class \code{"yardstick"}
created by the command \code{\link{yardstick}}.
created by the command \code{\link{yardstick}}.

}
\value{
A window (class \code{"owin"}) enclosing the plotted graphics.
Expand All @@ -81,15 +118,11 @@
plot(ys, angle=90, frac=0.08)
ys <- shift(ys, c(0, 0.3))
plot(ys, split=TRUE)

yt <- shift(ys, c(0, 0.2))
plot(yt, style="z", pos=3, zebra.step=0.1, txt.args=list(offset=0.1))
}
\author{\adrian


\rolf

and \ege

}
\author{\spatstatAuthors.}
\seealso{
\code{\link{yardstick}}
}
Expand Down

0 comments on commit a6eac41

Please sign in to comment.