R/ProjectedPoints2Grid.R

In DatabionicSwarm: Swarm Intelligence for Self-Organized Clustering

ProjectedPoints2Grid <- function(ProjectedPoints, Lines, Columns,PlotIt=FALSE, Cls){
# ProjectedPoints2Grid(ProjectedPoints,Lines,Columns)  
# Converts numeric ProjectedPoints to integervalues corresponding to a two dimensional rectangular grid
# INPUT
# ProjectedPoints[n,1:2] or [n,1:3] matrix containing the number of n coordinates !(x,y)! of the Projection
#                                   if [n,1:3] the first column has to be the key
#
# Lines                             Default(50), widght of the retangular grid
# Optional
# Columns                           height of the rectangular grid
#                                   We are able to calculate Columns by using Lines and der Range of Data in x and y
# PlotIt                            Difference plottet in new Window, if TRUE
# 
# OUTPUT
# BestMatches[n,Key,Lines,Columns]  Integer GridPositons(1:Lines,1:Colums) corresponding to numerical !(y,x)! coordinates
#                                   can be saved with WriteBM
# author MT 07/2015
# Note: Problem: Machmal  werden verschiedener Punkte werden an die gleiche Gitterstelle transformiert
#       jetzige Loesung: Wenn es zuviele doppelte gibt, einfach Lines vergroessern!
#       mögliche spaetere Loesung: Im speateren Verlauf könnten Voronoi-Nachbahrschaften verwendet werde statt einem Gitter
#                         -> generalisierte Abstrakte Umatrix
  
  
# Behandlungen verschiedener EingabeTypen
if(!is.matrix(ProjectedPoints))
    stop('ProjectedPoints has to be a matrix')
#if(!missing(Columns))
#  if(Lines>Columns)
#    stop('Lines has to be smaller or equal Columns')

n=nrow(ProjectedPoints)
c=ncol(ProjectedPoints)
if(c>3 |c<2)
  stop(paste0('Wrong number of Columns of ProjectedPoints: ',c))

if(missing(Cls)){
  Cls = rep(1,n)
}
if(c==3){
   coord=ProjectedPoints[,2:3]
   coordtmp=ProjectedPoints[,2:3]
}else{
   coord=ProjectedPoints
   coordtmp=ProjectedPoints
}

# Define Range of Data
minX <- min(coord[,1])
minY <- min(coord[,2])
maxX <- max(coord[,1])
maxY <- max(coord[,2])
RangeX=maxX-minX
RangeY=maxY-minY

# Per Definition: RangeY<RangeX because Linese<Columns, if not rotate
if(RangeY>RangeX){ 
  coord=coord[,c(2,1)]
  drehen=T
  #print(RangeX)
  #print(RangeY)
}else{
  drehen=F
}
# If Columns not chosen, Calculate it respectivly to the range of Data
if(missing(Columns)){
  Columns =round(Lines/RangeY*RangeX,0)
  while(Columns*Lines<4096){ #Empirisch min 2500 Neuronen und Lines<Columns
    Columns=Columns+1
  }
  print(paste('Estimating Columnlength with',Columns))
}
# Make all coordinates positiv.
if(minX < 1){
	coord[,1] <- coord[,1]+(-minX+1) # +1 to get the minimum to 1 (not 0).
}
if(minY < 1){
	coord[,2] <- coord[,2]+(-minY+1) # +1 to get the minimum to 1 (not 0).
}

# Update min and calculate max.

maxX <- max(coord[,1])
maxY <- max(coord[,2])

minX <- min(coord[,1])
minY <- min(coord[,2])


# Subtract min to be sure that the coordinates start with 0 after scaling.
if(minX<=minY){
	rCoord <- coord-minX
} else {
	rCoord <- coord-minY
}

# Update min and calculate max.
minX <- min(rCoord[,1])
maxX <- max(rCoord[,1])
minY <- min(rCoord[,2])
maxY <- max(rCoord[,2])

# Make sure the coordinates with the biggest value is on y-axis (Columns values!)
# to use the maximum of the Grid.
# Divide by maxX or maxY so all coordinates are scaled and are between 0 and 1.
if(maxX>=maxY){
	rCoord <- rCoord/maxX

} else {
	# Make sure the coordinates with the biggest value is on x-axis (Columns values!)
	# to use the maximum of the Grid.
	rCoord <- rCoord[,c(2,1)]
	rCoord <- rCoord/maxY
}

# Update min and calculate max.
minX <- min(rCoord[,1])
maxX <- max(rCoord[,1])
minY <- min(rCoord[,2])
maxY <- max(rCoord[,2])

# Calculate the max value to multiply with (to fit the Grid).
fact1 <- min(Columns-1,Lines-1)/maxY # 
fact2 <- max(Columns-1,Lines-1)/maxX
# choose the smaller value to be sure not to extend the maximum gitter size.

fact <- min(fact1,fact2)
rCoord <- round(rCoord*fact)
# To get the min value from 0 to 1.
rCoord <- rCoord+1

# Update min and calculate max.
minX <- min(rCoord[,1])
maxX <- max(rCoord[,1])
minY <- min(rCoord[,2])
maxY <- max(rCoord[,2])

# Centering the points on the grid
if((Columns-maxX)>=2){ # Otherwise you can't move the x-coordinates.
	rCoord[,1] <- rCoord[,1]+floor((Columns-maxX)/2)
}
if((Lines-maxY)>=2){ # Otherwise you can't move the y-coordinates.
	rCoord[,2] <- rCoord[,2]+floor((Lines-maxY)/2)
}

#Fehlerabfang, das zwei Punkte auf dem selben Gitterpukt leigen, welche vorher
# nicht unique waren
AnzPoints <- nrow(coordtmp)            # soviele punkte in den Daten
dists <- as.matrix(dist(coordtmp))     # Distance with diagonal = 0.
vecdists=dists[upper.tri(dists, diag = F)]
nvorher=AnzPoints-length(which(vecdists==0)) #number of duplicates

AnzPoints <- nrow(rCoord)            # soviele punkte in den Daten
dists <- as.matrix(dist(rCoord))     # Distance with diagonal = 0.
vecdists=dists[upper.tri(dists, diag = F)]
nnachher=AnzPoints-length(which(vecdists==0))  #number of duplicates

#nvorher=nrow(uniquePoints(coordtmp)$unique)
#nnachher=nrow(uniquePoints(rCoord)$unique)
if(nvorher!=nnachher){
  print(paste('Different Points are now on the same grid position. Sum of unique points (before) (after):', nvorher,nnachher))
}

# If rotatet, rotate back
if(drehen)
  BestMatches=cbind(1:n,rCoord[,c(2:1)]) #umgekehrt Definiert wie x,y koordinaten
else
  BestMatches=cbind(1:n,rCoord[,c(1:2)]) #umgekehrt Definiert wie x,y koordina

if(PlotIt){
  #windows()
  par(mfrow = c(1,2))
  plotSwarm(coordtmp, Cls = Cls, main='ProjectedPoints')
  plotSwarm(BestMatches[,2:3], Cls = Cls, main='Corresponding BestMatches')
}
return(BestMatches)

}