Water collected between towers
- 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
<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
ES5
<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
<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
<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) Do i=1 To words(bars)
bar.i=word(bars,i) 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 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 End m=n End
Say bars '->' w Return</lang>
- Output:
1 5 3 7 2 -> 2 5 3 7 2 6 4 5 9 1 2 -> 14 2 6 3 5 2 8 1 4 2 2 5 3 5 7 4 1 -> 35 5 5 5 5 -> 0 5 6 7 8 -> 0 8 7 7 6 -> 0 6 7 10 7 6 -> 0
zkl
<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)