Water collected between towers

From Rosetta Code
Task
Water collected between towers
You are encouraged to solve this task according to the task description, using any language you may know.
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, completely filling all 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 can be held in this way, by a corresponding bar chart.

Calculate the number of water units that could be collected by bar charts representing each of the following seven series:

   [[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:



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>

AWK

<lang AWK>

  1. syntax: GAWK -f WATER_COLLECTED_BETWEEN_TOWERS.AWK [-v debug={0|1}]

BEGIN {

   wcbt("1,5,3,7,2")
   wcbt("5,3,7,2,6,4,5,9,1,2")
   wcbt("2,6,3,5,2,8,1,4,2,2,5,3,5,7,4,1")
   wcbt("5,5,5,5")
   wcbt("5,6,7,8")
   wcbt("8,7,7,6")
   wcbt("6,7,10,7,6")
   exit(0)

} function wcbt(str, ans,hl,hr,i,n,tower) {

   n = split(str,tower,",")
   for (i=n; i>=0; i--) { # scan right to left
     hr[i] = max(tower[i],(i<n)?hr[i+1]:0)
   }
   for (i=0; i<=n; i++) { # scan left to right
     hl[i] = max(tower[i],(i!=0)?hl[i-1]:0)
     ans += min(hl[i],hr[i]) - tower[i]
   }
   printf("%4d : %s\n",ans,str)
   if (debug == 1) {
     for (i=1; i<=n; i++) { printf("%-4s",tower[i]) } ; print("tower")
     for (i=1; i<=n; i++) { printf("%-4s",hl[i]) } ; print("l-r")
     for (i=1; i<=n; i++) { printf("%-4s",hr[i]) } ; print("r-l")
     for (i=1; i<=n; i++) { printf("%-4s",min(hl[i],hr[i])) } ; print("min")
     for (i=1; i<=n; i++) { printf("%-4s",min(hl[i],hr[i])-tower[i]) } ; print("sum\n")
   }

} function max(x,y) { return((x > y) ? x : y) } function min(x,y) { return((x < y) ? x : y) } </lang>

Output:
   2 : 1,5,3,7,2
  14 : 5,3,7,2,6,4,5,9,1,2
  35 : 2,6,3,5,2,8,1,4,2,2,5,3,5,7,4,1
   0 : 5,5,5,5
   0 : 5,6,7,8
   0 : 8,7,7,6
   0 : 6,7,10,7,6

Haskell

Following cdk's Haskell solution at Stack Overflow:

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

   sum $                    -- Sum of water depths over each of: 
       filter (> 0) $           -- the columns that are covered by some water.
           zipWith (-)              -- Where coverages are differences between
               (zipWith min         -- water levels,   (lower in each case of:
                   (scanl1 max xs)      -- highest wall to left, and 
                   (scanr1 max xs)      -- highest wall to right)
               )
               xs                   -- and column tops.
     

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

ES5

Translation of: Haskell

<lang JavaScript>(function () {

   'use strict';
   // waterCollected :: [Int] -> Int
   var waterCollected = function (xs) {
       return sum(                   // water above each bar
           zipWith(function (a, b) {
                   return a - b;     // difference between water level and bar
               },
               zipWith(min,          // lower of two flanking walls
                   scanl1(max, xs),  // highest walls to left
                   scanr1(max, xs)   // highest walls to right
               ), 
               xs                    // tops of bars
           )
           .filter(function (x) {
               return x > 0;         // only bars with water above them
           })
       );
   };
   // GENERIC FUNCTIONS ----------------------------------------
   // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
   var zipWith = function (f, xs, ys) {
       var ny = ys.length;
       return (xs.length <= ny ? xs : xs.slice(0, ny))
           .map(function (x, i) {
               return f(x, ys[i]);
           });
   };
   // scanl1 is a variant of scanl that has no starting value argument
   // scanl1 :: (a -> a -> a) -> [a] -> [a]
   var scanl1 = function (f, xs) {
       return xs.length > 0 ? scanl(f, xs[0], xs.slice(1)) : [];
   };
   // scanr1 is a variant of scanr that has no starting value argument
   // scanr1 :: (a -> a -> a) -> [a] -> [a]
   var scanr1 = function (f, xs) {
       return xs.length > 0 ? scanr(f, xs.slice(-1)[0], xs.slice(0, -1)) : [];
   };
   // scanl :: (b -> a -> b) -> b -> [a] -> [b]
   var scanl = function (f, startValue, xs) {
       var lst = [startValue];
       return xs.reduce(function (a, x) {
           var v = f(a, x);
           return lst.push(v), v;
       }, startValue), lst;
   };
   // scanr :: (b -> a -> b) -> b -> [a] -> [b]
   var scanr = function (f, startValue, xs) {
       var lst = [startValue];
       return xs.reduceRight(function (a, x) {
           var v = f(a, x);
           return lst.push(v), v;
       }, startValue), lst.reverse();
   };
   // sum :: (Num a) => [a] -> a
   var sum = function (xs) {
       return xs.reduce(function (a, x) {
           return a + x;
       }, 0);
   };
   // max :: Ord a => a -> a -> a
   var max = function (a, b) {
       return a > b ? a : b;
   };
   // min :: Ord a => a -> a -> a
   var min = function (a, b) {
       return b < a ? b : a;
   };
   // 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 JavaScript>[2, 14, 35, 0, 0, 0, 0]</lang>

ES6

Translation of: Haskell

<lang JavaScript>(() => {

   'use strict';
   
   // waterCollected :: [Int] -> Int
   const waterCollected = xs => {
       const maxToRight = scanr1(max, xs),
           maxToLeft = scanl1(max, xs),
           levels = zipWith(min, maxToLeft, 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]));
   }
   // scanl1 is a variant of scanl that has no starting value argument
   // scanl1 :: (a -> a -> a) -> [a] -> [a]
   const scanl1 = (f, xs) =>
       xs.length > 0 ? scanl(f, xs[0], xs.slice(1)) : [];
   // scanr1 is a variant of scanr that has no starting value argument
   // scanr1 :: (a -> a -> a) -> [a] -> [a]
   const scanr1 = (f, xs) =>
       xs.length > 0 ? scanr(f, xs.slice(-1)[0], xs.slice(0, -1)) : [];
   // 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;


   // 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 JavaScript>[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)

REXX

<lang rexx>/* REXX */ Call bars '1 5 3 7 2' Call bars '5 3 7 2 6 4 5 9 1 2' Call bars '2 6 3 5 2 8 1 4 2 2 5 3 5 7 4 1' Call bars '5 5 5 5' Call bars '5 6 7 8' Call bars '8 7 7 6' Call bars '6 7 10 7 6' Exit bars: Parse Arg bars bar.0=words(bars) high=0 box.=' ' Do i=1 To words(bars)

 bar.i=word(bars,i)
 high=max(high,bar.i)
 Do j=1 To bar.i
   box.i.j='x'
   End
 End

m=1 w=0 Do Forever

 Do i=m+1 To bar.0
   If bar.i>bar.m Then
     Leave
   End
 If i>bar.0 Then Leave
 n=i
 Do i=m+1 To n-1
   w=w+bar.m-bar.i
   Do j=bar.i+1 To bar.m
     box.i.j='*'
     End
   End
 m=n
 End

m=bar.0 Do Forever

 Do i=bar.0 To 1 By -1
   If bar.i>bar.m Then
     Leave
   End
 If i<1 Then Leave
 n=i
 Do i=m-1 To n+1 By -1
   w=w+bar.m-bar.i
   Do j=bar.i+1 To bar.m
     box.i.j='*'
     End
   End
 m=n
 End

Say bars '->' w Call show Return show: Do j=high To 1 By -1

 ol=
 Do i=1 To bar.0
   ol=ol box.i.j
   End
 Say ol
 End

Return</lang>

Output:
1 5 3 7 2 -> 2
       x
       x
   x * x
   x * x
   x x x
   x x x x
 x x x x x
5 3 7 2 6 4 5 9 1 2 -> 14
               x
               x
     x * * * * x
     x * x * * x
 x * x * x * x x
 x * x * x x x x
 x x x * x x x x
 x x x x x x x x * x
 x x x x x x x x x x
2 6 3 5 2 8 1 4 2 2 5 3 5 7 4 1 -> 35
           x
           x * * * * * * * x
   x * * * x * * * * * * * x
   x * x * x * * * * x * x x
   x * x * x * x * * x * x x x
   x x x * x * x * * x x x x x
 x x x x x x * x x x x x x x x
 x x x x x x x x x x x x x x x x
5 5 5 5 -> 0
 x x x x
 x x x x
 x x x x
 x x x x
 x x x x
5 6 7 8 -> 0
       x
     x x
   x x x
 x x x x
 x x x x
 x x x x
 x x x x
 x x x x
8 7 7 6 -> 0
 x
 x x x
 x x x x
 x x x x
 x x x x
 x x x x
 x x x x
 x x x x
6 7 10 7 6 -> 0
     x
     x
     x
   x x x
 x x x x x
 x x x x x
 x x x x x
 x x x x x
 x x x x x
 x x x x x

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)