Nothing
XYcoords2LinesColumns=function(X,Y,minNeurons=4096,MaxDifferentPoints=F,PlotIt=FALSE,na.rm=FALSE){
#XYcoords2LinesColumns(X,Y)
# Converts points given as x(i),y(i) coordinates to integer coordinates Columns(i),Lines(i)
# INPUT
# X(1:n), Y(1:n) coordinates: x(i),y(i) is the i-th point on a plane
#
# OPTIONAL
# minNeurons minimal size of the corresponding grid i.e max(Lines)*max(Columns)>=MinGridSize , default MinGridSize = 4096
# defined by the numer of neurons
# MaxDifferentPoints TRUE: the discretization error is minimal
# FALSE: number of Lines and Columns is minimal
# PlotIt Plots the result
# OUTPUT
# GridConvertedPoints[1:Columns,1:Lines,2] IntegerPositions on a grid corresponding to x,y
# LC vector of:
# Lines GridLines==max(GridConvertedPoints[,2])
# Columns GridColumns==max(GridConvertedPoints[,1])
# author MT 08/2015
#if(isTRUE(na.rm)){
#account for infinite values inf and -inf
X[!is.finite(X)]=NaN
Y[!is.finite(Y)]=NaN
if(sum(!is.finite(Y))>0|sum(!is.finite(X))>0){
warning("XYcoords2LinesColumns: Either X or Y have not finite values. GeneralizedUmatrix may fail with errors.")
}
#}
multiplot <-
function(...,
plotlist = NULL,
file,
cols = 1,
layout = NULL) {
requireNamespace('grid')
requireNamespace('ggplot2')
# Make a list from the ... arguments and plotlist
plots <- c(list(...), plotlist)
numPlots = length(plots)
# If layout is NULL, then use 'cols' to determine layout
if (is.null(layout)) {
# Make the panel
# ncol: Number of columns of plots
# nrow: Number of rows needed, calculated from # of cols
layout <- matrix(seq(1, cols * ceiling(numPlots / cols)),
ncol = cols,
nrow = ceiling(numPlots / cols))
}
if (numPlots == 1) {
print(plots[[1]])
} else {
# Set up the page
grid::grid.newpage()
grid::pushViewport(grid::viewport(layout = grid::grid.layout(nrow(layout), ncol(layout))))
# Make each plot, in the correct location
for (i in 1:numPlots) {
# Get the i,j matrix positions of the regions that contain this subplot
matchidx <-
as.data.frame(which(layout == i, arr.ind = TRUE))
print(plots[[i]],
vp = grid::viewport(
layout.pos.row = matchidx$row,
layout.pos.col = matchidx$col
))
}
}
}
temp = cbind(X, Y)
minX <- min(X,na.rm = na.rm)
minY <- min(Y,na.rm = na.rm)
maxX <- max(X,na.rm = na.rm)
maxY <- max(Y,na.rm = na.rm)
RangeXfirst = maxX - minX
RangeYfirst = maxY - minY
frac = RangeYfirst / RangeXfirst
Lines = -frac - 1 + sqrt(frac ^ 2 + 1 + (minNeurons - 2) * frac)
Columns = RangeXfirst / RangeYfirst * (Lines - 1) + 1
i = 0
while (round(Lines, 0) * round(Columns, 0) < minNeurons) {
i = i + 1
Lines = -frac - 1 + sqrt(frac ^ 2 + 1 + (minNeurons - 2) * frac) + i
Columns = RangeXfirst / RangeYfirst * (Lines - 1) + 1
}
# Update min and max.
minX <- min(X,na.rm = na.rm)
minY <- min(Y,na.rm = na.rm)
maxX <- max(X,na.rm = na.rm)
maxY <- max(Y,na.rm = na.rm)
RangeX = maxX - minX
RangeY = maxY - minY
X <- floor((X - minX) / RangeX * (Columns - 1) + 1)
Y <- floor((Y - minY) / RangeY * (Lines - 1) + 1)
maxX <- max(X,na.rm = na.rm)
maxY <- max(Y,na.rm = na.rm)
if (maxX > Columns)
warning('Columnsrange exceeded')
if (maxY > Lines)
warning('Linesrange exceeded')
rCoord = cbind(Y, X)
requireNamespace('mgcv')
nvorher = nrow(mgcv::uniquecombs(temp))
nnachher = nrow(mgcv::uniquecombs(rCoord))
#nvorher = nrow(uniquePoints(temp)$unique)
#nnachher = nrow(uniquePoints(rCoord)$unique)
if (MaxDifferentPoints) {
i = 0
while (0.9 * nvorher > nnachher) {
i = i + 1
Lines = -frac - 1 + sqrt(frac ^ 2 + 1 + (minNeurons - 2) * frac) + i
Columns = RangeXfirst / RangeYfirst * (Lines - 1) + 1
X = temp[, 1]
Y = temp[, 2]
minX <- min(X,na.rm = na.rm)
minY <- min(Y,na.rm = na.rm)
maxX <- max(X,na.rm = na.rm)
maxY <- max(Y,na.rm = na.rm)
RangeX = maxX - minX
RangeY = maxY - minY
X <- floor((X - minX) / RangeX * (Columns - 1) + 1)
Y <- floor((Y - minY) / RangeY * (Lines - 1) + 1)
maxX <- max(X,na.rm = na.rm)
maxY <- max(Y,na.rm = na.rm)
if (maxX > Columns)
warning('Columnsrange exceeded')
if (maxY > Lines)
warning('Linesrange exceeded')
rCoord = cbind(Y, X)
nvorher = nrow(mgcv::uniquecombs(temp))
nnachher = nrow(mgcv::uniquecombs(rCoord))
#nvorher = nrow(uniquePoints(temp)$unique)
#nnachher = nrow(uniquePoints(rCoord)$unique)
if (nvorher != nnachher) {
print(paste(
'Different Points are now on the same grid position:',
nvorher,
nnachher
))
}
} # end while
}# end if MaxDifferentPoints
if (PlotIt) {
# requireRpackage('ggplot2')
if(requireNamespace('ggplot2')){
sp2 <-
ggplot2::ggplot(as.data.frame(rCoord), ggplot2::aes(X, Y)) + ggplot2::geom_point() + ggplot2::ggtitle("Projected Points")
sp1 <-
ggplot2::ggplot(as.data.frame(temp), ggplot2::aes(X, Y)) + ggplot2::geom_point() + ggplot2::ggtitle("Grid Converted Points")
multiplot(sp1, sp2, cols = 2)
sp2 + ggplot2::coord_fixed(ratio = Columns / Lines)
sp1 + ggplot2::coord_fixed(ratio = RangeXfirst / RangeYfirst)
}else{
message(
'Subordinate clustering package (ggplot2) is missing. No plotting is performed.
Please install the package which is defined in "Suggests".'
)
}
# windows()
# par(mfrow = c(1,2))
# plot(sp1)
# plot(sp2)
# PlotProjectedPoints(temp,NULL,FALSE,main='ProjectedPoints')
#PlotProjectedPoints(rCoord,NULL,T,main='Corresponding BestMatches')
}
return(list(
GridConvertedPoints = rCoord,
LC = c(Lines = round(Lines, 0), Columns = round(Columns, 0))
))
}
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.