14
\$\begingroup\$

You are provided a set of arbitary, unique, 2d, integer Cartesian coordinates: e.g. [(0,0), (0,1), (1,0)]

Find the longest path possible from this set of coordinates, with the restriction that a coordinate can be "visited" only once. (And you don't "come back" to the coordinate you started at).

Important:

You cannot "pass over" a coordinate or around it. For instance, in the last note example (Rectangle), you cannot move from D to A without visiting C (which may be a revisit, invalidating the length thus found). This was pointed out by @FryAmTheEggman.

Function Input: Array of 2d Cartesian Coordinates
Function Output: Maximum length only
Winner: Shortest code wins, no holds barred (Not the most space-time efficient)


Examples

Origin Triangle

1: In this case shown above, the longest path with no coordinate "visited" twice is A -> B -> O (or O-B-A, or B-A-O), and the path length is sqrt(2) + 1 = 2.414




Square

2: In this case shown above, the longest path with no coordinate "visited" twice is A-B-O-C (and obviously C-O-B-A, O-C-A-B etc.), and for the unit square shown, it calculates to sqrt(2) + sqrt(2) + 1 = 3.828.


Note: Here's an additional test case which isn't as trivial as the two previous examples. This is a rectangle formed from 6 coordinates:

enter image description here

Here, the longest path is: A -> E -> C -> O -> D -> B, which is 8.7147
(max possible diagonals walked and no edges traversed)

\$\endgroup\$
  • \$\begingroup\$ Here's a very similar question, albeit with different scoring. \$\endgroup\$ – Geobits Feb 19 '16 at 14:40
  • \$\begingroup\$ @Geobits Agreed, but I'd not say "very", having gone through the problem description there. And for that matter, any min/max path problem is essentially some flavor of your usual graph suspects. I'm interested in a byte saving solution here. \$\endgroup\$ – BluePill Feb 19 '16 at 14:43
  • \$\begingroup\$ @Fatalize Done. It's 8.7147. \$\endgroup\$ – BluePill Feb 19 '16 at 15:13
  • \$\begingroup\$ By the way: Welcome to PPCG! \$\endgroup\$ – Fatalize Feb 19 '16 at 15:14
  • \$\begingroup\$ @Fatalize Thank you! (Actually I've been an observer here for a while, just got active and into the whole thing starting today). :) \$\endgroup\$ – BluePill Feb 19 '16 at 15:15
3
\$\begingroup\$

Pyth, 105 103 100 92 86 bytes

V.pQK0FktlNJ.a[@Nk@Nhk)FdlNI&!qdk&!qdhkq+.a[@Nk@Nd).a[@Nd@Nhk)J=K.n5B)=K+KJ)IgKZ=ZK))Z

              Z = 0 - value of longest path
              Q = eval(input())

V.pQ         for N in permutations(Q):
  K0           K = 0 - value of current path
  FktlN        for k in len(N) - 1:
    J.a          set J = distance of
    [@Nk                 Q[k] and Q[k+1]
    @Nhk)    
    FdlN         for d in len(N):
I&                 if d != k && d != (k + 1)
!qdk
&!qdhk
q+                and if sum of
.a                   distance Q[k] and Q[d]
 [@Nk                
 @Nd)                
.a                   distance Q[d] and Q[k+1]
 [@Nd
 @Nhk)
J                    are equal to J then
  =K.n5              set K to -Infinity
  B                  and break loop
                     ( it means that we passed over point )
  )                   end of two if statements
=K+KJ                  K+=J add distance to our length
)                      end of for
IgKZ                   if K >= Z - if we found same or better path
  =ZK                  Z = K       set it to out max variable
))                     end of two for statements
Z                      output value of longest path 

Try it here!

\$\endgroup\$
2
\$\begingroup\$

Mathematica, 139 bytes

Max[Tr@BlockMap[If[1##&@@(Im[#/#2]&@@@Outer[#/Abs@#&[#-#2]&,l~Complement~#,#])==0,-∞,Abs[{1,-1}.#]]&,#,2,1]&/@Permutations[l=#+I#2&@@@#]]&

Test case

%[{{0,0},{0,1},{1,0},{1,1},{2,0},{2,1}}]
(* 3 Sqrt[2]+2 Sqrt[5] *)

%//N
(* 8.71478 *)
\$\endgroup\$
1
\$\begingroup\$

Perl, 341 322 318 bytes

sub f{@g=map{$_<10?"0$_":$_}0..$#_;$"=',';@l=grep{"@g"eq join$",sort/../g}glob"{@g}"x(@i=@_);map{@c=/../g;$s=0;$v=1;for$k(1..$#c){$s+=$D=d($k-1,$k);$_!=$k&&$_!=$k-1&&$D==d($_,$k)+d($_,$k-1)and$v=0 for 0..$#c}$m=$s if$m<$s&&$v}@l;$m}sub d{@a=@{$i[$c[$_[0]]]};@b=@{$i[$c[$_[1]]]};sqrt(($a[0]-$b[0])**2+($a[1]-$b[1])**2)}

The code supports up to a 100 points. Since it produces all possible point permutations, 100 points would require at least 3.7×10134 yottabytes of memory (12 points would use 1.8Gb).

Commented:

sub f {
    @g = map { $_<10 ? "0$_" : $_ } 0..$#_; # generate fixed-width path indices
    $" = ',';                               # set $LIST_SEPARATOR to comma for glob
    @l = grep {                             # only iterate paths with unique points
        "@g" eq join $", sort /../g         # compare sorted indices with unique indices
    } glob "{@g}" x (@i=@_);                # produce all permutations of path indices
                                            # and save @_ in @i for sub d
    map {
        @c = /../g;                         # unpack the path indices
        $s=0;                               # total path length
        $v=1;                               # validity flag
        for $k (1..$#c) {                   # iterate path
            $s +=                           # sum path length
                $D = d( $k-1, $k );         # line distance 

              $_!=$k && $_!=$k-1            # except for the current line,
              && $D == d( $_, $k )          # if the point is on the line,
                     + d( $_, $k-1 )
              and $v = 0                    # then reset it's validity
            for 0 .. $#c                    # iterate path again to check all points
        }
        $m=$s if $m<$s && $v                # update maximum path length
    } @l;
    $m                                      # return the max
}

sub d {                                     
    @a = @{ $i[$c[$_[0]]] };                # resolve the index $_[0] to the first coord
    @b = @{ $i[$c[$_[1]]] };                # idem for $_[1]
    sqrt( ($a[0] - $b[0])**2       
        + ($a[1] - $b[1])**2 )      
}

TestCases:

print f( [0,1], [0,0], [1,0] ), $/;        $m=0; # reset max for next call
print f( [0,0], [0,1], [1,0], [1,1] ), $/; $m=0;
print f( [0,0], [0,1], [0,2] ), $/;        $m=0;
print f( [0,0], [0,1], [0,2], 
         [1,0], [1,1], [1,2]),$/;          $m=0;
  • 322 bytes: save 19 by not resetting $", and some inlining
  • 318 bytes: save 4 by reducing max nr of coords to 100.
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.