-
Notifications
You must be signed in to change notification settings - Fork 0
/
plot-2d-grid.R
executable file
·153 lines (129 loc) · 5.29 KB
/
plot-2d-grid.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
146
147
148
149
150
151
152
153
#' Plot method for the \code{\link{trigrid}}, \code{\link{hexagrid}} or \code{\link{facelayer}} classes
#'
#' This function will invoke the \code{plot} method of the \code{\link[sf:sf]{sf}} or the \code{\link[sp]{SpatialPolygons}} class.
#' @param x (\code{\link{trigrid}}, \code{\link{hexagrid}} or \code{\link{facelayer}}) The object to be plotted.
#' @param crs (\code{character} or \code{\link[sf:st_crs]{crs}}) A coordinate system for the transformation of coordinates.
#' @param ... Arguments passed to the \code{plot} function.
#' @rdname plot
#' @return The function has no return value.
#' @exportMethod plot
"plot"
#' Plot method for the trigrid object class
#' @rdname plot
setMethod(
"plot",
signature="trigrid",
definition=function(x,crs=NULL,...){
# detect the what is available
sfplot <- FALSE
spplot <- FALSE
# these are missing values if they are not yet done
if(inherits(x@sf, "sf")) sfplot <- TRUE
if(inherits(x@sp, "Spatial")) spplot <- TRUE
# by default use the sf-method for plotting
if(sfplot){
if(!is.null(crs)){
x@sf <-sf::st_transform(x@sf, crs)
}
# use the plot method
plot(x@sf$geometry, ...)
}
# if the sf slot is not available, use sp
if(spplot & (!sfplot)){
# if the crs is given, use sf to do the transformation
if(!is.null(crs)){
x@sp <- methods::as(sf::st_transform(sf::st_as_sf(x@sp), crs), "Spatial")
}
# use the plot method
sp::plot(x@sp, ...)
}
if(!sfplot & !spplot){
stop("Both the @sp and @sf is empty. Use newsf() to add a 2d respresentation. ")
}
}
)
#' Lines method for the \code{trigrid} and \code{hexagrid} classes
#'
#' This function will invoke the method of the \code{\link[sp]{SpatialPolygons}} class.
#' This function will invoke the \code{lines} method of the \code{\link[sf:sf]{sf}} or the \code{\link[sp]{SpatialPolygons}} class.
#' @param x (\code{\link{trigrid}}, \code{\link{hexagrid}}) Object.
#' @param crs (\code{character} or \code{\link[sf:st_crs]{crs}}) A coordinate system for the transformation of coordinates.
#' @param col Line colors - as in \code{\link[graphics:par]{par}}
#' @param lwd Line thickness - as in \code{\link[graphics:par]{par}}
#' @param lty Line type - as in \code{\link[graphics:par]{par}}
#' @param ... Arguments passed to the \code{\link[sp:panel]{sp.lines}} method.
#' @rdname lines-methods
#' @return The function has no return value.
#' @exportMethod lines
setMethod(
"lines",
signature="trigrid",
definition=function(x,crs=NULL,col=1, lwd=1, lty=1, ...){
plot(x, crs=crs, add=TRUE, border=col, lwd=lwd, lty=lty,...)
}
)
#' Labels of grid vertices, faces and edges.
#'
#' This function will show where the grid elements are located.
#' @param gridObj (\code{\link{trigrid}}, \code{\link{hexagrid}}) An icosahedral grid.
#' @param type (\code{character}) The type of element to be plotted: either \code{"f"} (faces), \code{"v"} (vertices) or \code{"e"} (edges).
#' @param crs (\code{character} or \code{\link[sf:st_crs]{crs}}) A coordinate system for the transformation of coordinates.
#' @param ... Arguments passed to the \code{\link[graphics]{text}} function.
#' @return The function has no return value.
#' @export
#' @examples
#' gr <- hexagrid(sp=TRUE)
#' plot(gr)
#' gridlabs(gr)
gridlabs<-function(gridObj,type="f",crs=NULL,...){
# center back to origin if not there already
if(gridObj@center[1]!=0 | gridObj@center[2]!=0 | gridObj@center[3]!=0){
gridObj<-translate(gridObj,-gridObj@center)
}
if(type=="f"){
texts<-rownames(gridObj@faceCenters)
coords<-CarToPol(gridObj@faceCenters, norad=TRUE, origin=gridObj@center)
}
if(type=="v"){
texts<-rownames(gridObj@vertices)
coords<-CarToPol(gridObj@vertices, norad=TRUE, origin=gridObj@center)
}
if(type=="e"){
texts<-rownames(gridObj@edges)
coord3d<-t(apply(gridObj@edges, 1, function(x){
apply(gridObj@vertices[x,],2,mean)
}))
coords<-CarToPol(coord3d, norad=TRUE, origin=gridObj@center)
}
sfPoints <- sf::st_as_sf(as.data.frame(coords), crs=gridObj@crs, coords=c("long", "lat"))
#transformation is necessary
if(!is.null(crs)){
sfPoints <- sf::st_transform(sfPoints, crs=crs)
}
# detach coordinates
newCoords <- sf::st_coordinates(sfPoints)
graphics::text(labels=texts, x=newCoords[,1], y=newCoords[,2],...)
}
#' Locate grid faces based on their positions on a map
#'
#' The function returns which grid faces contain the points clicked in a plot.
#'
#' @param gridObj (\code{\link{trigrid}} or \code{\link{hexagrid}}) The grid object.
#' @param n (\code{integer}) The number of points to be looked up.
#' @param output (\code{character}) Type of output: \code{"faces"} returns only the face names of the points, \code{"full"} returns the coordinates as well.
#' @param ... Arguments passed to the \code{\link[graphics]{locator}} function.
#'
#' @export
#' @return A vector of \code{character} values, each corresponding to a face identifier.
cellocator <- function(gridObj,n, output="faces",...){
pointset<- locator(n=n, ...)
pointset <-cbind(pointset$x, pointset$y)
cells <- locate(gridObj, pointset)
if(output=="full"){
retVal<- data.frame(pointset, cells, stringsAsFactors=FALSE)
}
if(output=="faces"){
retVal<-cells
}
return(retVal)
}