Determining the rotation of square given a list of points

Question

In this challenge, you will be given a list of points. These points lie on the perimeter of an imaginary square. Your goal is to:

1. If possible, print out the rotation of the square, which will be a value from [0, 90) where 0 represents a square with lines vertical and horizontal. The rotation is to be given in degrees counted counter-clockwise.
2. If the rotation of the square is ambiguous (such as only being given 2 points), print out "Unknown"
3. If creating a square given the points is impossible, print out "Impossible"

The points you are given are guaranteed to be unique, and are in no particular order. You can use any format you wish to input the list, but for my examples, my points will be in the format x,y, and space separated. The numbers are floating-point numbers, and you can assume they are within a range that your language can handle. Your output should be accurate to at least 3 decimal places, and assume your language handles floating point numbers with perfect accuracy.

Here are some test cases (I have made most of these using whole numbers for easy visualizing, but your program should handle floating points):

Unknown:

0,0                      
0,0 1,0        
0,0 1,0 0,1              
0,0 1,0 0,1 1,1
0,1 0,2 1,0 1,3 2,0 2,3 3,1 3,2

Impossible:

0,0 1,0 2,0 3,1 4,2
0,0 1,0 2,0 1,1
0,1 0,2 1,0 1,3 2,0 2,3 3,1 3,2 2,2
2,0 0,1 2,2 0,3
0,0 2,1 0,2 2,2 -1,1

Possible (if not designated, should return 0):

0,0 1,0 2,0
0,0 0.3,0.3 0.6,0.6  (should return 45)
0,0 0.1,0.2 0.2,0.4  (should return appx 63.435 (the real value is arctan(2)))
0,0 0,1 2,1 2,2
0,1 0,2 1,0 1,4 2,0 2,4 4,1 4,3 

I may have missed some interesting test cases. If so, please comment to add them.

This is code-golf, so the shortest-code wins!

Answer 1

Rev 1: Ruby, 354 bytes

further golfing thanks to blutorange.

->a{t=s=Math::PI/18E4
d=r=c=0
a=a.map{|e|e-a[0]}
0.upto(36E4){|i|b=a.map{|e|(e/Complex.polar(1,i*s)).rect}.transpose
m,n=b
if n.min>=f=0
l=[m.max-x=m.min,n.max].max
a.each_index{|j|f+=((l-w=n[j])*(x+l-v=m[j])*(x-v)*w)**2}
(1E-9>q=f/l**8)&&(c>0&&(i-d)%9E4%89E3>1E3?c=9E9:0;c+=1;d=i)
q<t&&(r=i)&&t=q;end}
c<101&&a[1]?c<1?'impossible':r%9E4/1.0E3:'unknown'}

Ruby, 392 bytes

->(a){
s=Math::PI/18E4
t=1
d=r=c=0
a=a.map{|e|e-a[0]}
(0..36E4).each{|i|
b=a.map{|e|(e/Complex.polar(1,i*s)).rect}.transpose
m=b[0]
n=b[1]
x=m.min
if n.min>=0
l=[m.max-x,n.max].max
f=0
a.each_index{|j|f+=((l-n[j])*(x+l-m[j])*(x-m[j])*n[j])**2}
q=f/l**8
if q<1E-9
c>0&&(i-d)%9E4%89E3>1E3?(c=9E9):0
c+=1
d=i
end
if q<t
r=i
t=q
end
end
}
c>100||a.size<2?'unknown':c<1? 'impossible':r%9E4/1.0E3
}

The algorithm is as follows:

-Pick an arbitrary point (the first one) and move that to the origin (subtract the coordinates of this point from all points in the list.)

-Try all rotations of the square about the origin in 0.001 degree increments, through 360 degrees.

-For a given rotation, if all points are above the y axis, draw the smallest possible square around all the points, incorporating the lowest and leftmost point.

-Check if all points are on the edge. This is done with a soft calculation that takes each point, finds the squared distances from all edges, and multiplies them together. This gives a good fit rather than a yes/no answer. It is interpreted that a solution is found if this product divided by sidelength^8 is less than 1E-9. In practice this is less than a degree of tolerance.

-The best fit is taken mod 90 degrees and reported as the correct angle.

Currently the code returns a value of ambiguous if over 100 solutions are found (at 0.001 degree resolution. That's 0.1 degrees of tolerance.)

first fully working function, in test program

I left the resolution at 1/10th of the required resolution to make the speed reasonable. There is an error of 0.01 degress on the very last test case.

g=->(a){
 s=Math::PI/18000
 t=1
 d=r=-1
 c=0
 a=a.map{|e| e-a[0]} 

 (0..36000).each{|i| 
    b=a.map{|e|(e/Complex.polar(1,i*s)).rect}.transpose

    m=b[0]
    n=b[1]
    x=m.min

    if n.min>=0

       l=[m.max-x,n.max].max
       f=0
       a.each_index{|j|f+=((l-n[j])*(x+l-m[j])*(x-m[j])*n[j])**2}
       q=f/l**8

       if q<1E-9

         j=(i-d)%9000
         c>0&&j>100&&j<8900?(c=9E9):0 
         c+=1
         d=i
       end  

       if q<t
         r=i
         t=q
       end

     end    
  }

 print "t=",t,"   r=",r,"     c=",c,"    d=",d,"\n"
 p c>100||a.size<2?'unknown':c<1? 'impossible':r%9000/100.0   
}


#ambiguous
#g.call([Complex(0,0)])
#g.call([Complex(0,0),Complex(1,0)])
#g.call([Complex(0,0),Complex(1,0),Complex(0,1)])
#g.call([Complex(0,0),Complex(1,0),Complex(0,1),Complex(1,1)])
#g.call([Complex(0,1),Complex(0,2),Complex(1,0),Complex(1,3),Complex(2,0),Complex(2,3),Complex(3,1),Complex(3,2)])

#impossible
#g.call([Complex(0,0),Complex(1,0),Complex(2,0),Complex(3,1),Complex(4,2)])
#g.call([Complex(0,0),Complex(1,0),Complex(2,0),Complex(1,1)])
#g.call([Complex(0,1),Complex(0,2),Complex(1,0),Complex(1,3),Complex(2,0),Complex(2,3),Complex(3,1),Complex(3,2),Complex(2,2)])
#g.call([Complex(2,0),Complex(0,1),Complex(2,2),Complex(0,3)])
#g.call([Complex(0,0),Complex(2,1),Complex(0,2),Complex(2,2),Complex(-1,1)])

#possible
g.call([Complex(0,0),Complex(1,0),Complex(2,0)])
g.call([Complex(0,0),Complex(0.3,0.3),Complex(0.6,0.6)]) #(should return 45)
g.call([Complex(0,0),Complex(0.1,0.2),Complex(0.2,0.4)]) #(should return appx 63.435 (the real value is arctan(2)))
g.call([Complex(0,0),Complex(0,1),Complex(2,1),Complex(2,2)])
g.call([Complex(0,1),Complex(0,2),Complex(1,0),Complex(1,4),Complex(2,0),Complex(2,4),Complex(4,1),Complex(4,3)])

golfed version, resolution compliant with spec, takes about a minute per call, in test program.

There's still a pesky error of 0.001 degrees on the last test case. Increasing resolution further would probably eliminate it.

g=->(a){                                                            #take an array of complex numbers as input
  s=Math::PI/18E4                                                   #step size PI/180000
  t=1                                                               #best fit found so far
  d=r=c=0                                                           #angles of (d) last valid result, (r) best fit; c= hit counter
  a=a.map{|e|e-a[0]}                                                #move shape so that first point coincides with origin
  (0..36E4).each{|i|                                                #0..360000
    b=a.map{|e|(e/Complex.polar(1,i*s)).rect}.transpose             #rotate each element by dividing by unit vector of angle i*s, convert to array... 
    m=b[0]                                                          #...transpose array [[x1,y1]..[xn,yn]] to [[x1..xn],[y1..yn]]...
    n=b[1]                                                          #...and assign to variables m and n 
    x=m.min                                                         #find leftmost point
    if n.min>=0                                                     #if all points are above x axis
       l=[m.max-x,n.max].max                                        #find the sidelength of smallest square in which they will fit
       f=0                                                          #f= accumulator for errors. For each point
       a.each_index{|j|f+=((l-n[j])*(x+l-m[j])*(x-m[j])*n[j])**2}   #...add to f the product of the squared distances from each side of the smallest square containing all points
       q=f/l**8                                                     #q= f normalized with respect to the sidelength.
       if q<1E-9                                                    #consider a hit if <1E-9
         c>0&&(i-d)%9E4%89E3>1E3?(c=9E9):0                          #if at least one point is already found, and the difference between this hit and the last exceeds+/-1 deg (mod 90), set c to a high value
         c+=1                                                       #increment hit count by 1 (this catches infinitely varible cases)
         d=i                                                        #store the current hit in d
       end  
       if q<t                                                       #if current fit is better than previous one
        r=i                                                         #store the new angle
        t=q                                                         #and revise t to the new best fit.
       end             
    end
  }
  c>100||a.size<2?'unknown':c<1? 'impossible':r%9E4/1.0E3           #calculate and return value, taking special care of case where single point given.
}
#ambiguous
puts g.call([Complex(0,0)])
puts g.call([Complex(0,0),Complex(1,0)])
puts g.call([Complex(0,0),Complex(1,0),Complex(0,1)])
puts g.call([Complex(0,0),Complex(1,0),Complex(0,1),Complex(1,1)])
puts g.call([Complex(0,1),Complex(0,2),Complex(1,0),Complex(1,3),Complex(2,0),Complex(2,3),Complex(3,1),Complex(3,2)])

#impossible
puts g.call([Complex(0,0),Complex(1,0),Complex(2,0),Complex(3,1),Complex(4,2)])
puts g.call([Complex(0,0),Complex(1,0),Complex(2,0),Complex(1,1)])
puts g.call([Complex(0,1),Complex(0,2),Complex(1,0),Complex(1,3),Complex(2,0),Complex(2,3),Complex(3,1),Complex(3,2),Complex(2,2)])
puts g.call([Complex(2,0),Complex(0,1),Complex(2,2),Complex(0,3)])
puts g.call([Complex(0,0),Complex(2,1),Complex(0,2),Complex(2,2),Complex(-1,1)])

#possible
puts g.call([Complex(0,0),Complex(1,0),Complex(2,0)])
puts g.call([Complex(0,0),Complex(0.3,0.3),Complex(0.6,0.6)]) #(should return 45)
puts g.call([Complex(0,0),Complex(0.1,0.2),Complex(0.2,0.4)]) #(should return appx 63.435 (the real value is arctan(2)))
puts g.call([Complex(0,0),Complex(0,1),Complex(2,1),Complex(2,2)])
puts g.call([Complex(0,1),Complex(0,2),Complex(1,0),Complex(1,4),Complex(2,0),Complex(2,4),Complex(4,1),Complex(4,3)])

Note that for about 30% more code this algorithm could be adapted to work fast: it is obvious that in cases with a finite number of solutions, one of the edges lies flat along a a cube, so all we really have to try is those angles that correspond to each pair of vertices. It would also be necessary to do a bit of wiggling to check there aren't there aren't infinitely many solutions.

Answer 2

Perl

Hello, here is my humble soution. Test cases are put in DATA stream at the bottom of the file. The algorithm has grown by a try-error approach.
I admit that it is a broadly heuristic approach, but it is really fast: it resolves all the cases instantly.
I am aware there will be some bugs, but up to now it gives correct replies to all the test cases.
I am also aware that the shortest code wins, but I am sure this is among the shortest in the fastest meaning of the term.

Here is the algorithm

1. examine dots and for each segment between two dots record slope, length, x-intercept, y-intercept

2. find straight lines (i.e. three dots or two adjacent segments) and distinct possible slopes (say them rotations). Keep track of the longest segment available in each line.

3. find all the distances between a segment and a third point (this should be used to point 4). Keep track of minimum non-zero distance.

4. for any four dots (rougly a rectangle) find inner dots

Show solutions:

A. Say "Impossible" if there are one or more inner dots.

B. One Line:

• In case of most of dots in a single line without inner dots, say "Possible"

• In case of dots too close to line, say "Impossible"

  C. Two lines:

• Say "Possible" when there is only one possible rotation

• Say "Impossible" when there are more than one rotation

  D. No lines: find rotation that fits its 90° rotate segment

• Say "Possible" if only one fits or as many as dots fit.

• Say "Impossible" if more than one fits and not as many as dots

• Say "Unknown" if as many as rotation fit.

Here is the code (all known bugs are resolved)

#!/usr/bin/perl
use strict ;
use warnings ;
my $PI = 4*atan2( 1, 1 ) ;
my $EPS = 0.000001 ;
while ( <DATA> ) {
    if ( /^\s*#/ ) { print ; next } # print comments
    chomp ;
    my @dot = split /\s+/ ;
    my $n = scalar @dot || next ; # skip empty lines

    # too few dots
    if ( $n < 3 ) {
        print "@dot : Unknown.\n" ;
        next
    }

    my %slop = () ; # segment --> its slope
    my %leng = () ; # segment --> its length
    my %x0   = () ; # segment --> its line's x-intercept
    my %y0   = () ; # segment --> its line's y-intercept
    my %side = () ; # slope   --> list of segments (with duplicates)

    # 1. examine dots
    for my $p (@dot) {
        my ($px,$py) = split /,/, $p ;
        for my $q (@dot) {
            next if $p eq $q ;
            next if defined ( $slop{ "$q $p" } ) ;
            my $segment_name = "$p $q" ;
            my ($qx,$qy) = split /,/, $q ;
            my $dx = $px - $qx ;
            my $dy = $py - $qy ;
            my $slope = "inf" ; $slope = $dy / $dx if abs($dx) > 0 ;
            my $sd = $dx*$dx+$dy*$dy ;
            my $x0 = ( $slope eq 'inf' ? $px : "nan" ) ;
            my $y0 = ( abs($slope) > 0 ? $px : "nan" ) ;
            $x0 = $qx - $qy / $slope if abs($slope) > 0 ;
            $y0 = $qy - $qx * $slope if $slope ne "inf" ;
            push @{ $side{ $slope } }, $segment_name ;
            $slop{ $segment_name } = $slope ;
            $leng{ $segment_name } = sqrt( $sd ) ;
            $x0{ $segment_name } = $x0 ;
            $y0{ $segment_name } = $y0 ;
        }
    }

    # 2. find straight lines and distinct possible slopes (rotation)
    my %line = () ;     # slope --> segment name
    my %rotation = () ; # slope --> slope itself
    my $a_rotation ;
    for my $slope ( keys %side ) {
        my %distinct = () ;
        for my $segment_name ( @{ $side{ $slope } } ) {
            $distinct{ $segment_name } = $slope ; 
            my $rot = $slope eq 'inf' ? '0' : abs( $slope < 0 ? 1/$slope : $slope ) ;
            $rotation{ $rot } = $rot ;
            $a_rotation = $rot ;
        }
        for my $a_segm ( keys %distinct ) {
            for my $b_segm ( keys %distinct ) {
                next if $a_segm eq $b_segm ;
                # the two segment has to be adjacent
                my ($a1,$a2) = split / /, $a_segm;
                my ($b1,$b2) = split / /, $b_segm;
                next unless $a1 eq $b1 || $a1 eq $b2 || $a2 eq $b1 || $a2 eq $b2 ;
                # the two segment has to have same intercepts
                my $x0a = $x0{ $a_segm } ;
                my $x0b = $x0{ $b_segm } ;
                my $y0a = $y0{ $a_segm } ;
                my $y0b = $y0{ $b_segm } ;
                next unless $x0a eq $x0b && $y0a eq $y0b ;
                # keep the longest segment
                my $a_len = 0 ;
                $a_len = $leng{ $line{ $slope } } if defined( $line{ $slope } ) && defined( $leng{ $line{ $slope } } ) ;
                for my $segm ("$a1 $b1", "$a1 $b2", "$a2 $b1", "$a2 $b2",
                              "$b1 $a1", "$b2 $a1", "$b1 $a2", "$b2 $a2" ) {
                    next unless defined ( $leng{ $segm } ) ;
                    if ( $a_len < $leng{ $segm } ) {
                        $a_len = $leng{ $segm } ;
                        $line{ $slope } = $segm ;
                    }
                }
            }
        }
    }

    # 3. find distance between a segment and a third point
    my %distance = () ;            # segment-point --> distance
    my %distance_mani = () ;       # distance --> array of segment-point
    my %min_distance = () ;        # segment --> min distance to other dots
    for my $segment_name ( keys %slop ) {
        my $a = $slop{ $segment_name } ;
        my $b = -1 ;
        my $c = $y0{ $segment_name } ;
        my $z = $x0{ $segment_name } ;
        for my $p (@dot) {
            next if $segment_name =~ /$p/ ; # skip dots that are in the segment
            my ($px,$py) = split /,/, $p ;
            my $d = 0 ;
            if ( $a ne 'inf' ) {
                my $num = ($b * $py) + ($a * $px) + $c ;
                my $den = sqrt( $a*$a + $b*$b ) ;
                $d = abs( $num ) / $den ;
            }
            else {
                $d = abs( $px - $z );
            }
            $distance{ "$segment_name $p" } = $d ;
            push @{ $distance_mani{ $d } }, "$segment_name $p" ;
            if ( $d > 0 ) {
                $min_distance{ $segment_name } = $d if !defined ( $min_distance{ $segment_name } ) or $d < $min_distance{ $segment_name }
            }
        }
    }

    # 4. find inner dots: pick 4 dots to form a well shaped pseudo-rectangle
    #    and check for any other dot that is too close to all the 4 sides.
    my $fail = 0 ;
    RECTANGLE:
    for my $a ( @dot ) {
        for my $b ( @dot ) {
            next if $a eq $b ;
            my ($ax,$ay) = split /,/, $a ;
            my ($bx,$by) = split /,/, $b ;
            next if $ax > $bx || $ay > $by ;
            for my $c ( @dot ) {
                next if $c eq $a or $c eq $b ;
                my ($cx,$cy) = split /,/, $c ;
                next if $bx < $cx || $by > $cy ;
                for my $d ( @dot ) {
                    next if $d eq $a or $d eq $b or $d eq $c ;
                    my ($dx,$dy) = split /,/, $d ;
                    next if $cx < $dx || $cy < $dy  ;
                    next if $dx > $ax || $dy < $ay  ;
                    for my $e ( @dot ) {
                        next if $e eq $a or $e eq $b or $e eq $c or $e eq $d ;

                        my $abe = $distance{ "$a $b $e" } || $distance{ "$b $a $e" } || next ;
                        my $bce = $distance{ "$b $c $e" } || $distance{ "$c $b $e" } || next ;
                        my $cde = $distance{ "$c $d $e" } || $distance{ "$d $c $e" } || next ;
                        my $dae = $distance{ "$d $a $e" } || $distance{ "$a $d $e" } || next ;

                        my $abd = $distance{ "$a $b $d" } || $distance{ "$b $a $d" } || next ;
                        my $abc = $distance{ "$a $b $c" } || $distance{ "$b $a $c" } || next ;
                        my $bca = $distance{ "$b $c $a" } || $distance{ "$c $b $a" } || next ;
                        my $bcd = $distance{ "$b $c $d" } || $distance{ "$c $b $d" } || next ;
                        my $cdb = $distance{ "$c $d $b" } || $distance{ "$d $c $b" } || next ;
                        my $cda = $distance{ "$c $d $a" } || $distance{ "$d $c $a" } || next ;
                        my $dac = $distance{ "$d $a $c" } || $distance{ "$a $d $c" } || next ; 
                        my $dab = $distance{ "$d $a $b" } || $distance{ "$a $d $b" } || next ; 

                        if ( $abd > $abe && $abc > $abe && 
                             $bca > $bce && $bcd > $bce &&
                             $cdb > $cde && $cda > $cde &&
                             $dac > $dae && $dab > $dae) {
                            ## print "     $a $b $c $d --> $e\n";
                            $fail ++ ;
                            last RECTANGLE ;
                        }
                    }
                }
            }
        }
    }
    if ( $fail ) {
        print "@dot : Impossible.\n" ;
        next # DATA 
    }

    my $m = scalar keys %rotation ; # how many distinct slopes
    my $r = scalar keys %line ; # how many lines i.e. >3 dots in a straight line

    print "@dot : " ;
    # most of dots lie in single line without inner dots
    if ( $r == 1 ) {
        $a_rotation = (keys %line)[0] ;
        my $a_segment = $line{ $a_rotation } ;
        my $a_dist = $min_distance{ $a_segment } || 0 ;
        if ( $a_dist && $a_dist < $leng{ $a_segment } ) {
            print "Impossible.\n"  ;
        }
        else {
            print "Possible. --> " . sprintf("%.3f deg", 180 / $PI * atan2( $a_rotation, 1 ) ) . "\n" ;
        }
        next # DATA
    }
    # two lines
    if ( $r == 2 ) {
        print "Impossible.\n" if $m > 1 ;
        print "Possible. --> " .
            sprintf("%.3f deg", 180 / $PI * atan2( $a_rotation, 1 ) ) . "\n" if $m == 1 ;  # never?
        next ; # DATA
    }
    # no lines
    if ( $r == 0 ) {
        # match between segment rotation and other side
        my $count = 0 ;
        my $numeros = 0 ;
        for my $slope ( keys %rotation ) {
            my $rot = $slope eq '0' ? 'inf' : -1/$slope ;
            if ( exists $side{ $rot } ) {
                $count++ ;
                my $u = scalar @{ $side{ $rot } } ;
                if ( $numeros < $u ) {
                    $numeros = $u ;
                    $a_rotation = $slope ;
                }
            }
        }
        print "Possible. --> " .
            sprintf("%.3f deg", 180 / $PI * atan2( $a_rotation, 1 ) ) . "\n" if $count < 2 or $count == $n ;
        print "Unknown.\n"    if $count == $m ;
        print "Impossible.\n"    if $count > 2 && $count != $n && $count != $m;
        next # DATA
    }
    # there are lines
    print "lines $r " ;
    my $shorter = 0 ;
    my $longer = 0 ;
    for my $slope ( keys %line ) {
        for my $dis ( keys %distance_mani ) {
            $shorter++ ;
            $longer++ ;
        }
    }
    print "ACK! WHAT IS THIS CASE! n=$n, m=$m, r=$r\n" ;
    1 ;
}

1;

__DATA__
# Unknown:

0,0
0,0 1,0
0,0 1,0 0,1
0,0 1,0 0,1 1,1
0,1 0,2 1,0 1,3 2,0 2,3 3,1 3,2

# Impossible:

0,0 1,0 2,0 3,1 4,2
0,0 1,0 2,0 1,1
0,1 0,2 1,0 1,3 2,0 2,3 3,1 3,2 2,2
2,0 0,1 2,2 0,3
0,0 2,1 0,2 2,2 -1,1

# Possible (if not designated, should return 0):

0,0 1,0 2,0 1,2
0,0 1,0 2,0 0.5,2.1

0,0 1,0 2,0
0,0 1,0 2,0 1,2
0,0 0.3,0.3 0.6,0.6
0,0 0.1,0.2 0.2,0.4
0,0 0,1 2,1 2,2
0,1 0,2 1,0 1,4 2,0 2,4 4,1 4,3

And here is its ouptut

# Unknown:
0,0 : Unknown.
0,0 1,0 : Unknown.
0,0 1,0 0,1 : Unknown.
0,0 1,0 0,1 1,1 : Unknown.
0,1 0,2 1,0 1,3 2,0 2,3 3,1 3,2 : Unknown.
# Impossible:
0,0 1,0 2,0 3,1 4,2 : Impossible.
0,0 1,0 2,0 1,1 : Impossible.
0,1 0,2 1,0 1,3 2,0 2,3 3,1 3,2 2,2 : Impossible.
2,0 0,1 2,2 0,3 : Impossible.
0,0 2,1 0,2 2,2 -1,1 : Impossible.
# Possible (if not designated, should return 0):
0,0 1,0 2,0 1,2 : Possible. --> 0.000 deg
0,0 1,0 2,0 0.5,2.1 : Possible. --> 0.000 deg
0,0 1,0 2,0 : Possible. --> 0.000 deg
0,0 1,0 2,0 1,2 : Possible. --> 0.000 deg
0,0 0.3,0.3 0.6,0.6 : Possible. --> 45.000 deg
0,0 0.1,0.2 0.2,0.4 : Possible. --> 63.435 deg
0,0 0,1 2,1 2,2 : Possible. --> 0.000 deg
0,1 0,2 1,0 1,4 2,0 2,4 4,1 4,3 : Possible. --> 0.000 deg

Regards.

Matteo.