Water collected between towers

Water collected between towers is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Task

In a two-dimensional world, we begin with any bar-chart (or row of close-packed 'towers', each of unit width), and then it rains, filling any convex enclosures in the chart with water.

9               ██           9               ██    
8               ██           8               ██    
7     ██        ██           7     ██░░░░░░░░██    
6     ██  ██    ██           6     ██░░██░░░░██    
5 ██  ██  ██  ████           5 ██░░██░░██░░████    
4 ██  ██  ████████           4 ██░░██░░████████    
3 ██████  ████████           3 ██████░░████████    
2 ████████████████  ██       2 ████████████████░░██
1 ████████████████████       1 ████████████████████

In the example above, a bar chart representing the values [5, 3, 7, 2, 6, 4, 5, 9, 1, 2] has filled, collecting 14 units of water.

Write a function, in your language, from a given array of heights, to the number of water units that would be collected in this way, by a corresponding bar chart.

Display test results for water collected by bar charts for the following 7 series of bar heights:

   [[1, 5, 3, 7, 2],
    [5, 3, 7, 2, 6, 4, 5, 9, 1, 2],
    [2, 6, 3, 5, 2, 8, 1, 4, 2, 2, 5, 3, 5, 7, 4, 1],
    [5, 5, 5, 5],
    [5, 6, 7, 8],
    [8, 7, 7, 6],
    [6, 7, 10, 7, 6]]

See, also:

• Four Solutions to a Trivial Problem – a Google Tech Talk by Guy Steele
• Water collected between towers on Stack Overflow, from which the example above is taken)
• An interesting Haskell solution, using the Tardis monad, by Phil Freeman in a Github gist.

AppleScript

Translation of: JavaScript

<lang AppleScript>-- waterCollected :: [Int] -> Int on waterCollected(xs)

   set leftWalls to scanl1(my max, xs)
   set rightWalls to scanr1(my max, xs)
   
   set waterLevels to zipWith(my min, leftWalls, rightWalls)
   
   -- positive :: Num a => a -> Bool
   script positive
       on lambda(x)
           x > 0
       end lambda
   end script
   
   -- minus :: Num a => a -> a -> a
   script minus
       on lambda(a, b)
           a - b
       end lambda
   end script
   
   sum(filter(positive, zipWith(minus, waterLevels, xs)))

end waterCollected

-- TEST ------------------------------------------------------------------ on run

   map(waterCollected, ¬
       [[1, 5, 3, 7, 2], ¬
           [5, 3, 7, 2, 6, 4, 5, 9, 1, 2], ¬
           [2, 6, 3, 5, 2, 8, 1, 4, 2, 2, 5, 3, 5, 7, 4, 1], ¬
           [5, 5, 5, 5], ¬
           [5, 6, 7, 8], ¬
           [8, 7, 7, 6], ¬
           [6, 7, 10, 7, 6]])
   
   --> {2, 14, 35, 0, 0, 0, 0}

end run

-- GENERIC FUNCTIONS ------------------------------------------------------

-- scanl1 :: (a -> a -> a) -> [a] -> [a] on scanl1(f, xs)

   if length of xs > 0 then
       scanl(f, item 1 of xs, items 2 thru -1 of xs)
   else
       {}
   end if

end scanl1

-- scanr1 :: (a -> a -> a) -> [a] -> [a] on scanr1(f, xs)

   if length of xs > 0 then
       scanr(f, item -1 of xs, items 1 thru -2 of xs)
   else
       {}
   end if

end scanr1

-- scanl :: (b -> a -> b) -> b -> [a] -> [b] on scanl(f, startValue, xs)

   tell mReturn(f)
       set v to startValue
       set lng to length of xs
       set lst to {startValue}
       repeat with i from 1 to lng
           set v to lambda(v, item i of xs, i, xs)
           set end of lst to v
       end repeat
       return lst
   end tell

end scanl

-- scanr :: (b -> a -> b) -> b -> [a] -> [b] on scanr(f, startValue, xs)

   tell mReturn(f)
       set v to startValue
       set lng to length of xs
       set lst to {startValue}
       repeat with i from lng to 1 by -1
           set v to lambda(v, item i of xs, i, xs)
           set end of lst to v
       end repeat
       return reverse of lst
   end tell

end scanr

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] on zipWith(f, xs, ys)

   set nx to length of xs
   set ny to length of ys
   if nx < 1 or ny < 1 then
       {}
   else
       set lng to cond(nx < ny, nx, ny)
       set lst to {}
       tell mReturn(f)
           repeat with i from 1 to lng
               set end of lst to lambda(item i of xs, item i of ys)
           end repeat
           return lst
       end tell
   end if

end zipWith

-- map :: (a -> b) -> [a] -> [b] on map(f, xs)

   tell mReturn(f)
       set lng to length of xs
       set lst to {}
       repeat with i from 1 to lng
           set end of lst to lambda(item i of xs, i, xs)
       end repeat
       return lst
   end tell

end map

-- filter :: (a -> Bool) -> [a] -> [a] on filter(f, xs)

   tell mReturn(f)
       set lst to {}
       set lng to length of xs
       repeat with i from 1 to lng
           set v to item i of xs
           if lambda(v, i, xs) then set end of lst to v
       end repeat
       return lst
   end tell

end filter

-- sum :: Num a => [a] -> a on sum(xs)

   script add
       on lambda(a, b)
           a + b
       end lambda
   end script
   
   foldl(add, 0, xs)

end sum

-- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs)

   tell mReturn(f)
       set v to startValue
       set lng to length of xs
       repeat with i from 1 to lng
           set v to lambda(v, item i of xs, i, xs)
       end repeat
       return v
   end tell

end foldl

-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f)

   if class of f is script then
       f
   else
       script
           property lambda : f
       end script
   end if

end mReturn

-- init :: [a] -> [a] on init(xs)

   if length of xs > 1 then
       items 1 thru -2 of xs
   else
       {}
   end if

end init

-- tail :: [a] -> [a] on tail(xs)

   if length of xs > 1 then
       items 2 thru -1 of xs
   else
       {}
   end if

end tail

-- max :: Ord a => a -> a -> a on max(x, y)

   if x > y then
       x
   else
       y
   end if

end max

-- min :: Ord a => a -> a -> a on min(x, y)

   if y < x then
       y
   else
       x
   end if

end min

-- cond :: Bool -> a -> a -> a on cond(bool, f, g)

   if bool then
       f
   else
       g
   end if

end cond</lang>

Output:

<lang AppleScript>{2, 14, 35, 0, 0, 0, 0}</lang>

Haskell

Following cdk's Haskell solution at Stack Overflow:

<lang haskell>waterCollected :: [Int] -> Int waterCollected xs =

   -- water collects only in flanked concavities
   -- (i.e. where there is a gap between the high tide mark
   --       and the sea bed beneath)
   sum (filter (> 0) (zipWith (-) levels xs))
     -- high tide is the level of the lower of the
     -- two flanking walls
     where 
       levels = zipWith min (scanl1 max xs) (scanr1 max xs)

main :: IO () main = mapM_ (putStrLn . show . waterCollected) [

   [1, 5, 3, 7, 2],
   [5, 3, 7, 2, 6, 4, 5, 9, 1, 2],
   [2, 6, 3, 5, 2, 8, 1, 4, 2, 2, 5, 3, 5, 7, 4, 1],
   [5, 5, 5, 5],
   [5, 6, 7, 8],
   [8, 7, 7, 6],
   [6, 7, 10, 7, 6]]</lang>

Output:

2
14
35
0
0
0
0

JavaScript

ES6

Translation of: Haskell

<lang JavaScript>(() => {

   'use strict';

   const waterCollected = xs => {
       const maxToRight = scanr(max, 0, xs),
           maxToLeft = scanl(max, 0, xs),
           levels = zipWith(min, init(maxToLeft), tail(maxToRight));

       return sum(zipWith(difference, levels, xs)
           .filter(x => x > 0));
   };

   // GENERIC FUNCTIONS ----------------------------------------

   // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
   const zipWith = (f, xs, ys) => {
       const ny = ys.length;
       return (xs.length <= ny ? xs : xs.slice(0, ny))
           .map((x, i) => f(x, ys[i]));
   }

   // scanl :: (b -> a -> b) -> b -> [a] -> [b]
   const scanl = (f, startValue, xs) => {
       const lst = [startValue];
       return (
           xs.reduce((a, x) => {
               const v = f(a, x);
               return (lst.push(v), v);
           }, startValue),
           lst
       );
   };

   // scanr :: (b -> a -> b) -> b -> [a] -> [b]
   const scanr = (f, startValue, xs) => {
       const lst = [startValue];
       return (
           xs.reduceRight((a, x) => {
               const v = f(a, x);
               return (lst.push(v), v);
           }, startValue),
           lst.reverse()
       );
   };

   // difference :: (Num a) => a -> a -> a
   const difference = (a, b) => a - b;

   // sum :: (Num a) => [a] -> a
   const sum = xs => xs.reduce((a, x) => a + x, 0);

   // max :: Ord a => a -> a -> a
   const max = (a, b) => a > b ? a : b;

   // min :: Ord a => a -> a -> a
   const min = (a, b) => b < a ? b : a;

   // init :: [a] -> [a]
   const init = xs => xs.length ? xs.slice(0, -1) : undefined;

   // tail :: [a] -> [a]
   const tail = xs => xs.length ? xs.slice(1) : undefined;

   // TEST ---------------------------------------------------
   return [
       [1, 5, 3, 7, 2],
       [5, 3, 7, 2, 6, 4, 5, 9, 1, 2],
       [2, 6, 3, 5, 2, 8, 1, 4, 2, 2, 5, 3, 5, 7, 4, 1],
       [5, 5, 5, 5],
       [5, 6, 7, 8],
       [8, 7, 7, 6],
       [6, 7, 10, 7, 6]
   ].map(waterCollected);

   //--> [2, 14, 35, 0, 0, 0, 0]

})();</lang>

Output:

<lang>[2, 14, 35, 0, 0, 0, 0]</lang>

Perl 6

Translation of: Haskell

<lang perl6>sub max_l ( @a ) { [\max] @a } sub max_r ( @a ) { ([\max] @a.reverse).reverse }

sub water_collected ( @towers ) {

   return 0 if @towers <= 2;

   my @levels = max_l(@towers) »min« max_r(@towers);

   return ( @levels »-« @towers ).grep( * > 0 ).sum;

}

say map &water_collected,

   [ 1, 5,  3, 7, 2 ],
   [ 5, 3,  7, 2, 6, 4, 5, 9, 1, 2 ],
   [ 2, 6,  3, 5, 2, 8, 1, 4, 2, 2, 5, 3, 5, 7, 4, 1 ],
   [ 5, 5,  5, 5 ],
   [ 5, 6,  7, 8 ],
   [ 8, 7,  7, 6 ],
   [ 6, 7, 10, 7, 6 ],

</lang>

Output:

(2 14 35 0 0 0 0)

zkl

Translation of: Haskell

<lang zkl>fcn waterCollected(walls){

    // compile max wall heights from left to right and right to left
    // then each pair is left/right wall of that cell.
    // Then the min of each wall pair == water height for that cell
  scanl(walls,(0).max)     // scan to right, f is max(0,a,b)
 .zipWith((0).MAX.min,     // f is MAX.min(a,b) == min(a,b)
          scanl(walls.reverse(),(0).max).reverse()) // right to left
    // now subtract the wall height from the water level and add 'em up
  .zipWith('-,walls).filter('>(0)).sum(0);

} fcn scanl(xs,f,i=0){ // aka reduce but save list of results

  xs.reduce('wrap(s,x,a){ s=f(s,x); a.append(s); s },i,ss:=List()); 
  ss

} // scanl((1,5,3,7,2),max,0) --> (1,5,5,7,7)</lang> <lang zkl>T( T(1, 5, 3, 7, 2), T(5, 3, 7, 2, 6, 4, 5, 9, 1, 2),

  T(2, 6, 3, 5, 2, 8, 1, 4, 2, 2, 5, 3, 5, 7, 4, 1),
  T(5, 5, 5, 5), T(5, 6, 7, 8),T(8, 7, 7, 6),
  T(6, 7, 10, 7, 6) )

.pump(List, waterCollected).println();</lang>

Output:

L(2,14,35,0,0,0,0)