Nothing
DelaunayInfo <-
function(gidata, poly_info, rawdeldati, n_cells){
requireNamespace("deldir") #deldir function
requireNamespace("grDevices") #chull function
requireNamespace("splancs") #csr function
requireNamespace("sp") #point.in.polygon function
requireNamespace("conf.design") #factorize function
new_pt <- matrix(0, ncol = 2, nrow = 1)
#function to perform the transformation to get the new points which will be inside the parent polygon
New_Points <- function(scale_translate_info){
mat_scale <- matrix(c(scale_translate_info[1], 0, 0, scale_translate_info[2]), ncol = 2)
mat_tran <- matrix(c(scale_translate_info[3], scale_translate_info[4]), ncol = 1)
new_pt[1, ] <- t((mat_scale %*% matrix(c(rawdeldati[[ind1]][j, 1],
rawdeldati[[ind1]][j, 2]), ncol = 1)) + mat_tran)
return(new_pt)
}
#function to chop parent tile into smaller boxes
Parent_Tile_Boxes <- function(output_polygon){
xrange_parent_poly <- range(output_polygon[, 1])
yrange_parent_poly <- range(output_polygon[, 2])
#divide the range into segments
xseq_parent <- seq(xrange_parent_poly[1], xrange_parent_poly[2], length.out = 15)
yseq_parent <- seq(yrange_parent_poly[1], yrange_parent_poly[2], length.out = 15)
Points_on_ylines <- Points_on_xlines <- y_points_inside_polygon <- x_points_inside_polygon <- list()
for(i in 1: length(xseq_parent)){
#points on line with constant 'y'
Points_on_ylines[[i]] <- matrix(c(xseq_parent,
rep(yseq_parent[i], length(xseq_parent))),
ncol = 2, byrow = FALSE)
#points on line with constant 'x'
Points_on_xlines[[i]] <- matrix(c(rep(xseq_parent[i], length(yseq_parent)),
yseq_parent), ncol = 2, byrow = FALSE)
}
for(i in 1: length(xseq_parent)){
#points on line with constant 'x' and those that are inside the polygon
x_points_inside_polygon[[i]] <- Points_on_xlines[[i]][c(which(sp::point.in.polygon(Points_on_xlines[[i]][, 1],
Points_on_xlines[[i]][, 2],
output_polygon[, 1],
output_polygon[, 2]) != 0)), ,drop = FALSE]
#lines(x_points_inside_polygon[[i]][, 1], x_points_inside_polygon[[i]][, 2])
}
#constructing smaller polygons inside parent polygon
smaller_polygons_within_parent <- list()
#npoly <-0
no_of_small_poly <- 1
for(i in 1: (length(x_points_inside_polygon) - 1)){
#if there are 2 or more points on a line
if(length(x_points_inside_polygon[[i]][, 1]) > 1){
for(j in 1: (length(x_points_inside_polygon[[i]][, 1]) - 1)){
#if the consecutive y co-ordinates are present in the next line
if(x_points_inside_polygon[[i]][j, 2] %in% x_points_inside_polygon[[(i + 1)]][, 2] &&
x_points_inside_polygon[[i]][(j + 1), 2] %in% x_points_inside_polygon[[(i + 1)]][, 2]){
smaller_polygons_within_parent[[no_of_small_poly]] <- matrix(c(x_points_inside_polygon[[i]][j, ],
x_points_inside_polygon[[(i + 1)]][1, 1],
x_points_inside_polygon[[i]][j, 2],
x_points_inside_polygon[[(i + 1)]][1, 1],
x_points_inside_polygon[[i]][(j + 1), 2],
x_points_inside_polygon[[i]][j, 1],
x_points_inside_polygon[[i]][(j + 1), 2]),
ncol = 2, byrow = TRUE)
no_of_small_poly <- no_of_small_poly + 1
}
}
}
}
return(smaller_polygons_within_parent)
}
#function to chop sammon space into smaller boxes
Sammon_Space_Boxes <- function(input_polygon, nbox){
requireNamespace("grDevices") #chull function
requireNamespace("splancs") #csr function
requireNamespace("sp") #point.in.polygon function
requireNamespace("conf.design") #factorize function
xrange_sammon_poly <- range(input_polygon[, 1])
yrange_sammon_poly <- range(input_polygon[, 2])
#create same number of boxes as that in parent polygon
nbox_factors <- conf.design::factorize(nbox)
if(length(nbox_factors) == 1){
nbox <- nbox - 1
nbox_factors <- conf.design::factorize(nbox)
}
xseq_sammon <- seq(xrange_sammon_poly[1],
xrange_sammon_poly[2],
length.out = nbox_factors[length(nbox_factors)] + 1)
yseq_sammon <- seq(yrange_sammon_poly[1],
yrange_sammon_poly[2],
length.out = nbox / nbox_factors[length(nbox_factors)] + 1)
samPoints_on_ylines <- samPoints_on_xlines <- list()
for(i in 1: length(xseq_sammon)){
#points on line with constant 'x'
samPoints_on_xlines[[i]] <- matrix(c(rep(xseq_sammon[i], length(yseq_sammon)),
yseq_sammon),
ncol = 2, byrow = FALSE)
}
#constructing polygons inside sammon polygon
smaller_polygons_within_sammon <- list()
#npoly <-0
no_of_small_samPoly <- 1
for(l in 1: (length(samPoints_on_xlines) - 1)){
#if there are 2 or more points on a line
if(length(samPoints_on_xlines[[l]][, 1]) > 1){
for(m in 1: (length(samPoints_on_xlines[[l]][, 1]) - 1)){
#if the consecutive y co-ordinates are present in the next line
if(samPoints_on_xlines[[l]][m, 2] %in% samPoints_on_xlines[[(l + 1)]][, 2] &&
samPoints_on_xlines[[l]][(m + 1), 2] %in% samPoints_on_xlines[[(l + 1)]][, 2]){
smaller_polygons_within_sammon[[no_of_small_samPoly]] <- matrix(c(samPoints_on_xlines[[l]][m, ],
samPoints_on_xlines[[(l + 1)]][1, 1],
samPoints_on_xlines[[l]][m, 2],
samPoints_on_xlines[[(l + 1)]][1, 1],
samPoints_on_xlines[[l]][(m + 1), 2],
samPoints_on_xlines[[l]][m, 1],
samPoints_on_xlines[[l]][(m + 1), 2]),
ncol = 2, byrow = TRUE)
no_of_small_samPoly <- no_of_small_samPoly + 1
}
}
}
}
return(smaller_polygons_within_sammon)
}
#construct the polygons in parent tile
par_tile_polygon <- list()
#variable storing appropriate parent tile index
lindex <- c()
#for constructing sammon space polygon
xrange <- yrange <- sammon_space_polygon <- list()
#to store the chopped rectangles in both parent tile and sammon space
boxes_in_sammon_space <- boxes_in_parent_tile <- list()
#to store the scale-factors and translate matrix information
transformation_matrices_info <- int_list <- list()
#for the indices of the smaller rectangles containing sammon points in the sammon space polygon
rect_indices_containing_points <- inter_indices <- list()
#to store the transformed points
new_rawdeldati <- list()
parentTiles <- unique(gidata[, "Segment.Parent"])
for(ind1 in 1: length(parentTiles)){
if(((parentTiles[ind1]) %% n_cells)){
lindex[ind1] <- (parentTiles[ind1] %% n_cells)
}else{
lindex[ind1] <- n_cells
}
par_tile_polygon[[ind1]] <- matrix(c(poly_info[[lindex[ind1]]]$x,
poly_info[[lindex[ind1]]]$y),
ncol = 2, byrow = FALSE)
#construct the sammon space polygon using xrange and yrange of sammon
xrange[[ind1]] <- range(rawdeldati[[ind1]][, 1])
yrange[[ind1]] <- range(rawdeldati[[ind1]][, 2])
sammon_space_polygon[[ind1]] <- matrix(c(xrange[[ind1]][1], yrange[[ind1]][1],
xrange[[ind1]][2], yrange[[ind1]][1],
xrange[[ind1]][2], yrange[[ind1]][2],
xrange[[ind1]][1], yrange[[ind1]][2]),
ncol = 2, byrow = TRUE)
#represent each small box in the bigger polygon as a polygon
boxes_in_parent_tile[[ind1]] <- Parent_Tile_Boxes(par_tile_polygon[[ind1]])
nbox <- length(boxes_in_parent_tile[[ind1]])
if(nbox == 0){
return("-1")
}
boxes_in_sammon_space[[ind1]] <- Sammon_Space_Boxes(sammon_space_polygon[[ind1]], nbox)
#transformation_matrices_info will have scale matrix and translate matrix values for each
#rectangle-rectangle transformation from sammon space to parent polygon
#obtain the scale matrix
scaleMat <- ScaleMat(boxes_in_sammon_space[[ind1]][[1]],
boxes_in_parent_tile[[ind1]][[1]])
for(j in 1: length(boxes_in_sammon_space[[ind1]])){
#get the translate matrix values by giving scale matrix also as input
int_list[[j]] <- Transform_Coordinates(boxes_in_sammon_space[[ind1]][[j]],
boxes_in_parent_tile[[ind1]][[j]],
scaleMat)
}
transformation_matrices_info[[ind1]] <- int_list
int_list <- list()
#find the indices of the smaller boxes in sammon space in which the input sammon points exist
for(j in 1: length(rawdeldati[[ind1]][, 1])){
for(k in 1: length(boxes_in_sammon_space[[ind1]])){
if(sp::point.in.polygon(rawdeldati[[ind1]][j, 1],
rawdeldati[[ind1]][j, 2],
boxes_in_sammon_space[[ind1]][[k]][, 1],
boxes_in_sammon_space[[ind1]][[k]][, 2]) != 0){
inter_indices[[j]] <- k
}
}
}
rect_indices_containing_points[[ind1]] <- inter_indices
#using the indices obtained above and the scale and transzlate matrices to
#get the transformed coordinates for the input sammon datapoints
int_matrix <- matrix(0, ncol = 2, nrow = length(rawdeldati[[ind1]][, 1]))
row.names(int_matrix) <- row.names(rawdeldati[[ind1]])
for(j in 1: length(rawdeldati[[ind1]][, 1])){
int_matrix[j, ] <- New_Points(transformation_matrices_info[[ind1]][[rect_indices_containing_points[[ind1]][[j]]]])
}
new_rawdeldati[[ind1]] <- int_matrix
}
return(new_rawdeldati)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.