Compute the Hausdorff Distance

Question

Introduction

The Hausdorff distance measures the difference between two subsets of a metric space. Intuitively, a metric space is just some set with a built-in distance function; in this challenge, we will use natural numbers with the ordinary distance d(a, b) := abs(a - b). The Hausdorff distance between two non-empty finite sets A and B is given by

max(max(min(d(a, b) for b in B) for a in A),
    max(min(d(a, b) for a in A) for b in B))

in Python-like notation. The Hausdorff distance can be computed by finding the element of A for which the distance to the nearest element of B is maximal, and the element of B for which the distance to the nearest element of A is maximal, and then taking the maximum of these distances. In other words, if the Hausdorff distance is d, then every element of A is within distance d of some element of B, and vice versa.

Input

Your input is a single list of integers. It only contains the elements 0,1,2,3, which signify whether the given index of the list is an element of neither A nor B, only A, only B, or both A and B. For example, the input [0,1,1,0,2,3] means that A = {1,2,5} and B = {4,5}, if we use 0-based indexing (which makes no difference, as our metrics are translation invariant).

Output

Your output is the Hausdorff distance between A and B; in the above example, it is 3. If either set is empty, then the distance is not defined, and you shall return -1.

Rules

You can write a full program or a function. The lowest byte count wins, and standard loopholes are disallowed.

Test Cases

[] -> -1
[0] -> -1
[0,1,0] -> -1
[2,0,0,2] -> -1
[0,1,2,3] -> 1
[0,3,3,0,0,0,0,3] -> 0
[1,0,0,1,0,0,1,3,1] -> 7
[1,0,0,0,0,3,0,0,0,0,2] -> 5
[0,1,1,3,1,3,2,1,1,3,0,3] -> 2
[2,2,2,1,2,0,3,1,3,1,0,3] -> 3
[1,3,0,2,0,2,2,1,0,3,2,1,1,2,2] -> 2
[1,0,1,1,2,0,1,2,3,1,0,0,0,1,2,0] -> 4

Answer 1

CJam, 53 52 46 38 37 bytes

3,q~f{f&:L,{L=},}$~ff{-z}_z+::e<W+:e>

Takes input on STDIN as a CJam style array:

[0 1 2 3]

Here is a test harness which converts all the test cases to this format and runs the code on them. Although the results are in the input field, they are not used by the code (remove them if you don't trust me :)).

Explanation

First, we parse the input to get the two sets A and B:

3,q~f{f&:L,{L=},}$~
3,                  "Push [0 1 2]. 1 is for A, 2 is for B, and 0 we can luckily ignore
                     as we'll see later.";
  q~                "Read and evaluate the input.";
    f{          }   "Map this block onto the [0 1 2] array, copying in the input for
                     each iteration.";
      f&:L          "Take the bitwise AND with each element of the input and store the
                     result in L.";
          ,{  },    "Get the length N, and filter the range [0 .. N-1] by evaluating
                     the block for each element.";
            L=      "Check if the bitwise AND at that index yielded something non-zero.
                     This gives an empty array for 0, A for 1 and B for 2.";
                 $  "Sort the three arrays. This has two important effects: a) it moves
                     the empty array resulting from 0 to the front, and b) if only one
                     of A and B is empty, it moves the non-empty one to the end.";
                  ~ "Unwrap the array, dumping all three sets on the stack.";

And now we find the absolute differences and select the max of the mins:

ff{-z}_z+::e<W+:e>
ff{-z}             "Turn A and B into a matrix of absolute differences.";
      _z           "Duplicate and transpose.";
        +          "Add the two together, so I've got one row of distances for
                    each element in either A or B.";
         ::e<      "Find the minimum of each row.";
             W+    "Add a -1 in case one set was empty.";
               :e> "Get the overall maximum.";

Note that we've kept the empty array resulting from the initial 0 at the bottom of the stack all the time, but empty arrays don't contribute anything to the output.

Answer 2

CJam, 57 56 52 bytes

I think this can be golfed a bit, but here goes:

q~ee_{W=2%},\{W=1>},]0ff=_W%]{~ff-{:z$1<~}%W+$W=}/e>

Input goes in like a CJam styled list, eg.

[1 0 0 0 0 3 0 0 0 0 2]

5

How it works:

The code is split in two parts:

Parsing the input into the lists A and B:

q~ee_{W=2%},\{W=1>},]0ff=_W%]
q~                               "Eval the input array";
  ee                             "Enumerate and prepend index with each element. For ex:
                                  [5 3 6]ee gives [[0 5] [1 3] [2 6]]";
    _{W=2%},                     "Make a copy and filter out elements with value 1 or 3";
            \{W=1>},             "On the original, filter elements with value 2 or 3";
                    ]            "Wrap stack in an array. Stack right now contains
                                  enumerated A and B in an array";
                     0ff=        "Get the index of the enumerated arrays. Stack is [A B]";
                         _W%     "Make a copy and swap order. Stack is now [A B] [B A]";
                            ]    "Wrap this in an array";

Performing the required actions on the two pairs of A and B:

{~ff-{:z$1<~}%W+$W=}/e>
{                  }/            "Run this loop for both the pairs, [A B] and [B A]"
 ~ff-                            "Unwrap [A B] and take difference of every pair";
     {      }%                   "For each row in the matrix difference";
      :z$                        "abs each term and then sort";
         1<~                     "Take only the first element of the array";
              W+                 "Add -1 to compensate for an empty array";
                $W=              "Take max";
                     e>          "Take max of the two maximums";

Try it online here

Answer 3

Lua, 235 bytes

Definitely not a winner, but at least a fun challenge.

A={}B={}c={}d={}m=math p=m.min q=m.max u=unpack for k=1,#arg do for h=0,1 do if
arg[k]/2^h%2>=1 then A[#A+1]=k for i=1,#B do l=m.abs(B[i]-k)d[i]=p(d[i]or
l,l)c[#A]=p(c[#A]or l,l)end end A,B=B,A c,d=d,c end end
print(q(q(-1,u(c)),u(d)))

Input works like so:

lua hausdorff.lua <space-separated-sequence>

...and here's a test script:

local testcase = arg[1] or 'hausdorff.lua'
print('testing '..testcase)
local function run(args) 
    return function(expected)
        local result = tonumber(
            io.popen('lua.exe '..testcase..' '..args):read'*a':match'%S+')
        print(args..' -> '..expected..' :: '..result)
        assert(result == expected,
            ("for input %q expected %s but got %s"):format(
                args, expected, result))
    end
end
run''(-1)
run'0'(-1)
run'0 1 0'(-1)
run'2 0 0 2'(-1)
run'0 1 2 3'(1)
run'0 3 3 0 0 0 0 3'(0)
run'1 0 0 1 0 0 1 3 1'(7)
run'1 0 0 0 0 3 0 0 0 0 2'(5)
run'0 1 1 3 1 3 2 1 1 3 0 3'(2)
run'2 2 2 1 2 0 3 1 3 1 0 3'(3)
run'1 3 0 2 0 2 2 1 0 3 2 1 1 2 2'(2)
run'1 0 1 1 2 0 1 2 3 1 0 0 0 1 2 0'(4)

...produces...

testing hausdorff.lua
 -> -1 :: -1
0 -> -1 :: -1
0 1 0 -> -1 :: -1
2 0 0 2 -> -1 :: -1
0 1 2 3 -> 1 :: 1
0 3 3 0 0 0 0 3 -> 0 :: 0
1 0 0 1 0 0 1 3 1 -> 7 :: 7
1 0 0 0 0 3 0 0 0 0 2 -> 5 :: 5
0 1 1 3 1 3 2 1 1 3 0 3 -> 2 :: 2
2 2 2 1 2 0 3 1 3 1 0 3 -> 3 :: 3
1 3 0 2 0 2 2 1 0 3 2 1 1 2 2 -> 2 :: 2
1 0 1 1 2 0 1 2 3 1 0 0 0 1 2 0 -> 4 :: 4

Answer 4

Pyth, 43 40 39 38 bytes

J+m0yQQLq3.|Fb?eS.e&Yfy:J-kT+hkT0JyJ_1

My algorithm operates directly on the input string and never converts these number. It only calculate once a maximum and never a minimum.

Thanks to @isaacg for saving one byte.

Try it online: Pyth Compiler/Executor

Explanations:

First I'll insert a lot of zeros in front of the input.

          implicit: Q = input()
    yQ    powerset(Q)
  m0yQ    map each element of the powerset to 0 (creates 2^Q zeros, I said lots)
 +    Q   zeros + Q
J         assign to J

Then I define a helper function y, which tells if the indices of a list (like the input one) appear in both sets A and B. E.g. y([0, 1, 0, 0, 1, 1]) = False, but y([0, 1, 0, 2]) = y([3]) = True.

Lq3.|Fb
L          define a function y(b), which returns _
   .|Fb       fold b by bitwise or
 q3            == 3

Afterwards I first check if the result is -1.

?...yJ_1   print ... if numbers appear in both sets (`yJ`) else -1   

Now to the interesting stuff:

  .e              J    map each pair k,Y in enumerate(J) to:
    &Y                   Y and ... (acts as 0 if Y == 0 else ...)
      f          0       find the first number T >= 0, where:
       y                    indices appear in both sets in the substring
        :J-kT+hkT           J[k-T:k+T+1]
eS                     sort and take last element (maximum)

Notice, that I will always find a number T, since I already know that indices appear in both sets in the list J. The number is maximal length(Q). This is also the reason for inserting the zeros. If there are at least length(Q) zeros inserted, k-T is always >= 0, which is necessary for the list slicing. So why do I insert 2^length(Q) zeros instead of length(Q) zeros? In the test-case [] I need at least 1 zero, otherwise yJ will return an error.

Answer 5

Mathematica, 88 bytes

Max[Min/@#,Min/@Thread@#,-1]/.∞->-1&@Outer[Abs[#-#2]&,p=Position;p[#,1|3],p[#,2|3],1]&

Answer 6

Haskell, 145 126 124 bytes

s t x=[e|(e,i)<-zip[0..]x,t i]
d#e=maximum[minimum[abs$i-j|j<-e]|i<-d]
[]%_= -1
_%[]= -1
d%e=max(d#e)$e#d
f x=s(>1)x%s odd x

Test run:

*Main> map f [[], [0], [0,1,0], [2,0,0,2], [0,1,2,3],
              [0,3,3,0,0,0,0,3], [1,0,0,1,0,0,1,3,1],
              [1,0,0,0,0,3,0,0,0,0,2], [0,1,1,3,1,3,2,1,1,3,0,3],
              [2,2,2,1,2,0,3,1,3,1,0,3],
              [1,3,0,2,0,2,2,1,0,3,2,1,1,2,2],
              [1,0,1,1,2,0,1,2,3,1,0,0,0,1,2,0]]

[-1,-1,-1,-1,1,0,7,5,2,3,2,4]

s filters the natural numbers according to a predicate t and the input list x. # calculates the maximum distance of it's parameters d and e. % catches empty sets A or B or takes the final maximum of d#e and e#d. f is the main function which calls % with set A and B.

Edit: @Zgarb found lots of bytes to save; @ali0sha another 2. Thanks!

Answer 7

Perl, 56 55

Added +2 for -lp.

The input list should be given on stdin without spaces, e.g.:

echo 1011201231000120 | perl -lp hausdorf.pl

hausdorf.pl:

s%%$z=$_&=$p|=$'|P.$p;$q+=!!y/12/3/%eg;$_=$z=~3?$q:-1

To support spaces between the elements of the input list just divide the final $q by 2 for a cost of 2 strokes

Answer 8

Python 2, 124

This definitely feels suboptimal. Oh well.

lambda a,E=enumerate:-min([1]+[~l*(n<3)for i,n in E(a)for l,_ in E(a)if{0}|set(n*a+n/3*[5])>{0,n}>=set(a[max(i-l,0):i-~l])])

Answer 9

APL (49)

{(⊂⍬)∊∆←(↓2 2⊤⍵)/¨⊂⍳⍴⍵:¯1⋄⌈/{⌈/⌊/⍵}¨(+,⍉¨)|∘.-/∆}

Testcases:

      ({(⊂⍬)∊∆←(↓2 2⊤⍵)/¨⊂⍳⍴⍵:¯1⋄⌈/{⌈/⌊/⍵}¨(+,⍉¨)|∘.-/∆} ¨ testcases) ,⍨ '→',⍨ ↑ ⍕¨testcases
                               → ¯1
0                              → ¯1
0 1 0                          → ¯1
2 0 0 2                        → ¯1
0 1 2 3                        →  1
0 3 3 0 0 0 0 3                →  0
1 0 0 1 0 0 1 3 1              →  7
1 0 0 0 0 3 0 0 0 0 2          →  5
0 1 1 3 1 3 2 1 1 3 0 3        →  2
2 2 2 1 2 0 3 1 3 1 0 3        →  3
1 3 0 2 0 2 2 1 0 3 2 1 1 2 2  →  2
1 0 1 1 2 0 1 2 3 1 0 0 0 1 2 0→  4

Explanation:

• ⍳⍴⍵: get a list of numbers from 1 to the length of the input list
• ↓2 2⊤⍵: for each value in the input list, get the first byte and the second byte
• ∆←(...)/⊂⍳⍴⍵: for both lists of bytes, select the corresponding values from ⍳⍴⍵. Store these in ∆.

• (⊂⍬)∊∆...:¯1: if this list contains the empty list, return -1. Otherwise:

• |∘.-/∆: get the absolute difference between every pair of values, giving a matrix

• (+,⍉¨): get a rotated and a non-rotated copy of that matrix
• {⌈/⌊/⍵}: for both matrices, get the maximum of the minimums of the rows
• ⌈/: then get the maximum of that

Answer 10

Perl, 189 176 157B

Now with 500% more state.

use List::Util qw'max min';@I=<>;sub f{$n=($n%2)+1;map{$I[$_]&$n?$_:()}0..$#I}sub i{@t=f;max map{$b=$_;min map{abs$_-$b}@t}f}$r=max i,i;print defined$r?$r:-1

Legible:

use List::Util qw'max min';
@I=<>;
sub f {
    $n = ($n%2) + 1;
    map { $I[$_] & $n ? $_ : () } 0..$#I
}
sub i {
    @t = f;
    max map {
        $b = $_;
        min map { abs $_ - $b } @t
    } f
}
$r = max i,i;
print defined $r ? $r : -1

Example usage:

input

0
1
2
3

perl golf.pl < input

Answer 11

Clojure, 167 bytes

#(let[P apply F(fn[I](filter(fn[i](I(% i)))(range(count %))))A(F #{1 3})B(F #{2 3})d(fn[X Y](P min(for[x X](P max(for[y Y](P -(sort[x y])))))))](-(min(d A B)(d B A))))

There should be a shorter way... Is there?