I wrote a quick hack to generate the coordinates of the endpoints of all "cell walls" in an a plain old array of squares on integer coordinates.
dimx <- 4
dimy <- 5
xvert<-rep(1:(dimx+1),each=dimy)
yvert<-1:dimy
yvert<-rep(yvert,times=dimx+1)
vertwall<-cbind(xvert, xvert,yvert,yvert+1)
And similarly for the horizontal walls. It feels like I just reinvented some basic function, so: Faster, Better, Cleaner?
EDIT: consider a grid of cells. The bottom-left cell's two walls of interest have the coordinate x,y pairs (1,1),(1,2) and (1,1),(2,1) . Similar to the definition of crystal unit cells in solid-state physics, that's all that is required, as the next cell "up" has walls (1,2),(1,3) and (1,2),(2,2) and so on. Thus the reason for repeating the "xvert" data in my sample.
I am not sure to understand what do you try to do ( your column names are duplicated and this is confusing). You can try this for example:
df = expand.grid( yvert= seq_len(dimy),xver= seq_len(dimy))
transform(df,xvert1=xvert,yvert1=yvert+1)
CGW added for completeness' sake: generate both horizontal and vertical walls:
df = expand.grid( xvert= seq_len(dimx),yvert= seq_len(dimy))
transform(df,xvert1=xvert,yvert1=yvert+1) ->dfv
df2 <- expand.grid(yvert= seq_len(dimy), xvert= seq_len(dimx))
transform(df2,yvert1=yvert,xvert1=xvert+1) ->dfh
# make x,y same order in both arrays
dfh[] <- dfh[,c(2,1,4,3)]
The expand.grid function creates Cartesian products of arrays, which provides most of what you need to do.
expand.grid(x=1:5,y=1:5)
Related
Hej,
I have two lists of polygons.
The first one is a list of 1 polygon (circle)
The second is a list of 260 polygons (260 rectangles).
See the first picture (two lists of polygons).
Now I want to keep all the rectangles that are touched by the circle.
See picture 2 merge and 3 result.
Does somebody has any idea? There are serveral things. st_combine, st_intersection - but their are not useable for this problem.
Suppose your blocks are in a, and your circle in b; have you tried
a[lenghts(st_intersects(a, b)) > 0]
?
Without a reprex it's hard to give a full answer, but I think you want to use st_intersects. This can take two sf objects and return either a list of vectors of pairs that intersect (sparse = TRUE) or a full logical matrix of whether those indices intersect (sparse = FALSE). In this case, I would use the latter, and then appropriate filter to get only the rows you want.
Trying to get it done via mapply or something like this without iterations - I have a spatial dataframe in R and would like to subset all more complicated shapes - ie shapes with 10 or more coordinates. The shapefile is substantial (10k shapes) and the method that is fine for a small sample is very slow for a big one. The iterative method is
Street$cc <-0
i <- 1
while(i <= nrow(Street)){
Street$cc[i] <-length(coordinates(Street)[[i]][[1]])/2
i<-i+1
}
How can i get the same effect in any array way? I have a problem with accessing few levels down from the top (Shapefile/lines/Lines/coords)
I tried:
Street$cc <- lapply(slot(Street, "lines"),
function(x) lapply(slot(x, "Lines"),
function(y) length(slot(y, "coords"))/2))
/division by 2 as each coordinate is a pair of 2 values/
but is still returns a list with number of items per row, not the integer telling me how many items are there. How can i get the number of coordinates per each shape in a spatial dataframe? Sorry I do not have a reproducible example but you can check on any spatial file - it is more about accessing low level property rather than a very specific issue.
EDIT:
I resolved the issue - using function
tail()
Here is a reproducible example. Slightly different to yours, because you did not provide data, but the principle is the same. The 'principle' when drilling down into complex S4 structures is to pay attention to whether each level is a list or a slot, using [[]] to access lists, and # for slots.
First lets get a spatial ploygon. I'll use the US state boundaries;
library(maps)
local.map = map(database = "state", fill = TRUE, plot = FALSE)
IDs = sapply(strsplit(local.map$names, ":"), function(x) x[1])
states = map2SpatialPolygons(map = local.map, ID = IDs)
Now we can subset the polygons with fewer than 200 vertices like this:
# Note: next line assumes that only interested in one Polygon per top level polygon.
# I.e. assumes that we have only single part polygons
# If you need to extend this to work with multipart polygons, it will be
# necessary to also loop over values of lower level Polygons
lengths = sapply(1:length(states), function(i)
NROW(states#polygons[[i]]#Polygons[[1]]#coords))
simple.states = states[which(lengths < 200)]
plot(simple.states)
This is a part repeat of a question I asked a couple of days ago, but as has been pointed out I did so extremely poorly, so I'm sorry for that, I'm still learning how to minimalise everything. So I'll ask the two parts separately as it might make it easier for others to find the answers, and to actually answer in the first place (I hope).
I've used a diamond square algorithm (DSQA) I found from this website, which has the following output image
What I need to do is overlay a matrix to this output, which will then be populated with "species" - creating an ecosystem with species occupying different levels of the "terrain". Eventually I'd like to create a range for the "species", but for now I'd just like to know how to overlay the matrix in such a way that the species would populate different levels (e.g. a species at a "high/orange" location would have different co-ordinates(?) to one at a "lower/green"
The matrix I create looks something like this:
#Create Species Vector
species.v<-letters[1:5]
species.v<-as.character(species.v)
#Check species Vector
species.v
#Immigration Vector
immigration.lower<-letters[1:26]
immigration.vec<-toupper(immigration.lower)
immigration.vec
#Matrix creation (Random)
orig.neutral<- matrix(sample(species.v,25,replace=TRUE),
nrow=5,
ncol=5)
#Neutral Matrix
neutral.v0<-orig.neutral
#Create dice roll for replacement
dice.vector<-c(1:10)
dice.vector
#For loop and Ifs for replacement/immigration/speciation
for (i in 1:100) {{dice.roll<-sample(dice.vector,1)}###For Loop with IF functions
if(dice.roll <= 7) {
neutral.v0[sample(length(neutral.v0),1)]<-as.character(sample(neutral.v0,1))
} else if (dice.roll > 7 & dice.roll < 10){
neutral.v0[sample(length(neutral.v0),1)]<-as.character(sample(immigration.vec,1))
} else if (dice.roll == 10){
elIdx = sample(length(neutral.v0),1) #index of a randomly selected element
neutral.v0[elIdx] = paste(neutral.v0[elIdx], "2", sep="")
}}
The replacement and such is all part of a future ecosystem code, and will eventually have a check for the species input into the matrix being in the correct "range" of the DSQA output.
But what I need to know is how to overlay/merge/create this matrix with the DSQA output, so that matrix is part of the output. There don't need to be any limiting ranges at present, I just can't conceptualise how to merge these two separate pieces of code into one thing that I can work on.
So in the example, my matrix is only 5x5, but I have no idea how to create/specify the size of the DSQA Output, let alone ensure my matrix is part of it/effected by it. I don't know if I've got too high a density DSQA output for a simple 5x5 matrix maybe? The actual matrix I'm using in my project is 1000x1000 but that's unnecessarily large for an example, as was pointed out by #gregor, as I just need to know the concept of how to do this, which I can then apply to my ridiculously sized matrix/DSQA output.
I'm still not sure I've explained it well, but any help would be appreciated.
I found out what I was doing wrong, which was instead of taking the output of the diamond square algorithm as a matrix of values, I was trying to think about overlaying a different matrix over the top. The long and short was that I only have to refer to the diamond square algorithm output matrix, not directly use it as a "base" for a second higher matrix.
I have a dataset of XY points that looks like this
x<-c(2,4,6,3,7,9,1)
y<-c(6,4,8,2,9,6,1)
id<-c("a","b","c","d","e","f","g")
dataset<-data.frame(cbind(x,y,id))
I would like to connect all combinations of all points with spatial lines, with lines named with combinations of the points that they're connecting
In "attributes table" that results from the output, names for spatial lines might look like this:
a_b
a_c
a_d
a_e
a_f
a_g
b_a
b_c
b_d
b_e
b_f
b_g
c_a
etc.
I'm speculating a bit here as to what exactly you wanted, but I think you want to visualize the connections from any point to the others. If that's the case, then this might work.
But first, some assumptions:
Your x and y coordinates are starting points. Consequently, id are thus id.origin
All other points will need to become "destinations", and then their own coordinates will become x_destination and so on.
< disclaimer> There should be a better, more elegant way to do this. I'd appreciate if someone more experienced can jump in and show me any of the *ply ways to do it. < /disclaimer>
Replicate the dataframe to cover for all possible combinations
dataset<-do.call(rbind, replicate(7, dataset, simplify=FALSE))
Now, create a matrix with all the same destination points, mixed:
nm=matrix(ncol=3)
for (i in 1:7){
nm<-rbind(nm,do.call(rbind,replicate(7,as.matrix(dataset[i,]),simplify=FALSE)))
}
nm<-nm[-1,]
Rename the columns of matrix, so they make sense, and bind the existing data frame with the new matrix
colnames(nm)<-c("x2","y2","id.dest")
newds<-cbind(dataset,as.data.frame(nm))
Remove duplicated trajectories:
newds<-newds[-which(newds$id.origin==newds$id.dest),]
and plot the result using geom_segment:
p<-ggplot(newds,aes(x=x,y=y))+geom_segment(aes(xend=x2,yend=y2))
There is a way to name the segments, but from observing the plot I would't suggest doing it. Instead you might consider naming the points using geom_text (other options are available, see ?annotate for one).
p<-p + geom_text(aes(x=1.8,y=6.1,label="a"))
That will produce a plot like the one here:
The whole solution looks like this:
plot(dataset$x,dataset$y)
Replicate the dataframe to cover for all possible combinations
dataset<-do.call(rbind, replicate(7, dataset, simplify=FALSE))
Now, create a matrix with all the same destination points, mixed:
nm=matrix(ncol=3)
for (i in 1:7){
nm<-rbind(nm,do.call(rbind,replicate(7,as.matrix(dataset[i,]),simplify=FALSE)))
}
nm<-nm[-1,]
Rename the columns of matrix, so they make sense, and bind the existing data frame with the new matrix
colnames(nm)<-c("x2","y2","id.dest")
newds<-cbind(dataset,as.data.frame(nm))
Remove duplicated trajectories:
newds1<-newds[-which(newds$id==newds$id.dest),]
library(ggplot2)
Converting destination x & y to numeric from factor
newds1$x2<-as.numeric(as.character(newds1$x2)) #converting from factor to numeric
newds1$y2<-as.numeric(as.character(newds1$y2))
Plotting the destination points . . .same as the origin points
plot(newds1$x, newds1$y)
plot(newds1$x2, newds1$y2, col="red")
Now use code from this answer:
Convert Begin and End Coordinates into Spatial Lines in R
Raw list to store Lines objects:
l <- vector("list", nrow(newds1)) #
This l is now an empty vector w/ number of rows defined by length (nrow) of newds1
Splitting origin and destination coordinates so I can run this script:
origins<-data.frame(cbind(newds1$x, newds1$y))
destinations<-data.frame(cbind(newds1$x2, newds1$y2))
library(sp)
for (i in seq_along(l)) {
l[[i]] <- Lines(list(Line(rbind(origins[i, ], destinations[i,]))), as.character(i))
}
l.spatial<-SpatialLines(l)
plot(l.spatial, add=T)
So I have some lidar data that I want to calculate some metrics for (I'll attach a link to the data in a comment).
I also have ground plots that I have extracted the lidar points around, so that I have a couple hundred points per plot (19 plots). Each point has X, Y, Z, height above ground, and the associated plot.
I need to calculate a bunch of metrics on the plot level, so I created plotsgrouped with split(plotpts, plotpts$AssocPlot).
So now I have a data frame with a "page" for each plot, so I can calculate all my metrics by the "plot page". This works just dandy for individual plots, but I want to automate it. (yes, I know there's only 19 plots, but it's the principle of it, darn it! :-P)
So far, I've got a for loop going that calculates the metrics and puts the results in a data frame called Results. I pulled the names of the groups into a list called groups as well.
for(i in 1:length(groups)){
Results$Plot[i] <- groups[i]
Results$Mean[i] <- mean(plotsgrouped$PLT01$Z)
Results$Std.Dev.[i] <- sd(plotsgrouped$PLT01$Z)
Results$Max[i] <- max(plotsgrouped$PLT01$Z)
Results$75%Avg.[i] <- mean(plotsgrouped$PLT01$Z[plotsgrouped$PLT01$Z <= quantile(plotsgrouped$PLT01$Z, .75)])
Results$50%Avg.[i] <- mean(plotsgrouped$PLT01$Z[plotsgrouped$PLT01$Z <= quantile(plotsgrouped$PLT01$Z, .50)])
...
and so on.
The problem arises when I try to do something like:
Results$mean[i] <- mean(paste("plotsgrouped", groups[i],"Z", sep="$")). mean() doesn't recognize the paste as a reference to the vector plotsgrouped$PLT27$Z, and instead fails. I've deduced that it's because it sees the quotes and thinks, "Oh, you're just some text, I can't get the mean of you." or something to that effect.
Btw, groups is a list of the 19 plot names: PLT01-PLT27 (non-consecutive sometimes) and FTWR, so I can't simply put a sequence for the numeric part of the name.
Anyone have an easier way to iterate across my test plots and get arbitrary metrics?
I feel like I have all the right pieces, but just don't know how they go together to give me what I want.
Also, if anyone can come up with a better title for the question, feel free to post it or change it or whatever.
Try with:
for(i in seq_along(groups)) {
Results$Plot[i] <- groups[i] # character names of the groups
tempZ = plotsgrouped[[groups[i]]][["Z"]]
Results$Mean[i] <- mean(tempZ)
Results$Std.Dev.[i] <- sd(tempZ)
Results$Max[i] <- max(tempZ)
Results$75%Avg.[i] <- mean(tempZ[tempZ <= quantile(tempZ, .75)])
Results$50%Avg.[i] <- mean(tempZ[tempZ <= quantile(tempZ, .50)])
}