Water collected between towers: Difference between revisions
m (test data) |
|||
Line 34: | Line 34: | ||
<br> |
<br> |
||
=={{header|AppleScript}}== |
|||
{{Trans|JavaScript}} |
|||
<lang AppleScript>-- waterCollected :: [Int] -> Int |
|||
on waterCollected(xs) |
|||
set leftWalls to tail(scanl(my max, 0, xs)) |
|||
set rightWalls to init(scanr(my max, 0, 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], ¬ |
|||
[5, 5, 5, 5], ¬ |
|||
[5, 6, 7, 8], ¬ |
|||
[8, 7, 7, 6], ¬ |
|||
[6, 7, 10, 7, 6]]) |
|||
--> {2, 14, 0, 0, 0, 0} |
|||
end run |
|||
-- GENERIC FUNCTIONS ------------------------------------------------------ |
|||
-- 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> |
|||
{{Out}} |
|||
<lang AppleScript>{2, 14, 0, 0, 0, 0}</lang> |
|||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
Revision as of 19:19, 6 December 2016
- 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 6 series of bar heights:
[[1, 5, 3, 7, 2], [5, 3, 7, 2, 6, 4, 5, 9, 1, 2], [5, 5, 5, 5], [5, 6, 7, 8], [8, 7, 7, 6], [6, 7, 10, 7, 6]]
(See, for example, Water collected between towers on Stack Overflow, from which the example above is taken).
AppleScript
<lang AppleScript>-- waterCollected :: [Int] -> Int on waterCollected(xs)
set leftWalls to tail(scanl(my max, 0, xs)) set rightWalls to init(scanr(my max, 0, 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], ¬ [5, 5, 5, 5], ¬ [5, 6, 7, 8], ¬ [8, 7, 7, 6], ¬ [6, 7, 10, 7, 6]]) --> {2, 14, 0, 0, 0, 0}
end run
-- GENERIC FUNCTIONS ------------------------------------------------------
-- 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, 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)) where -- high tide is the level of the lower of the -- two flanking walls levels = zipWith min (init $ scanr max 0 xs) (tail $ scanl max 0 xs)
main :: IO () main = mapM_ (putStrLn . show . waterCollected) [
[1, 5, 3, 7, 2], [5, 3, 7, 2, 6, 4, 5, 9, 1, 2], [5, 5, 5, 5], [5, 6, 7, 8], [8, 7, 7, 6], [6, 7, 10, 7, 6]]</lang>
- Output:
2 14 0 0 0 0
JavaScript
ES6
<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 zipWith((a, b) => a - b, levels, xs) .filter(x => x > 0) .reduce((a, b) => a + b, 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() ); };
// 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], [5, 5, 5, 5], [5, 6, 7, 8], [8, 7, 7, 6], [6, 7, 10, 7, 6] ].map(waterCollected);
//--> [2, 14, 0, 0, 0, 0]
})();</lang>
- Output:
<lang>[2, 14, 0, 0, 0, 0]</lang>