Sum of first n cubes: Difference between revisions

→‎{{header|AppleScript}}: Replaced a map-accumulation with a scanning accumulation.
(→‎{{header|AppleScript}}: Replaced a map-accumulation with a scanning accumulation.)
(→‎{{header|AppleScript}}: Replaced a map-accumulation with a scanning accumulation.)
Line 57:
1071225 1168561 1272384 1382976 1500625</pre>
=={{header|AppleScript}}==
<lang applescript>-------------------(() SUM=> OF FIRST N CUBES -----------------{
"use strict";
 
// -------------- SUM OF FIRST N CUBES ---------------
-- sumsOfFirstNCubes :: Int -> [Int]
on sumsOfFirstNCubes(n)
script go
on |λ|(a, x)
a + (x ^ 3) as integer
end |λ|
end script
scanl(go, 0, enumFromTo(1, n - 1))
end sumsOfFirstNCubes
 
// sumsOfFirstNCubes :: Int -> [Int]
const sumsOfFirstNCubes = n =>
// Cumulative sums of first n cubes.
scanl(
a => x => a + (x ** 3)
)(0)(
enumFromTo(1)(n - 1)
);
 
--------------------------- TEST -------------------------
on run
table(5, sumsOfFirstNCubes(50))
end run
 
// ---------------------- TEST -----------------------
// main :: IO ()
const main = () =>
table(" ")(justifyRight)(
chunksOf(5)(
sumsOfFirstNCubes(50)
.map(x => `${x}`)
)
);
 
------------------------- GENERIC ------------------------
 
// --------------------- GENERIC ---------------------
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if m ≤ n then
set lst to {}
repeat with i from m to n
set end of lst to i
end repeat
lst
else
{}
end if
end enumFromTo
 
// enumFromTo :: Int -> Int -> [Int]
const enumFromTo = m =>
n => Array.from({
length: 1 + n - m
}, (_, i) => m + i);
 
-- 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 |λ|(v, item i of xs, i, xs)
set end of lst to v
end repeat
return lst
end tell
end scanl
 
// scanl :: (b -> a -> b) -> b -> [a] -> [b]
const scanl = f => startValue => xs =>
// The series of interim values arising
// from a catamorphism. Parallel to foldl.
xs.reduce((a, x) => {
const v = f(a[0])(x);
 
return [v, a[1].concat(v)];
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
}, [startValue, [startValue]])[1];
on mReturn(f)
-- 2nd class handler function lifted into 1st class script wrapper.
if script is class of f then
f
else
script
property |λ| : f
end script
end if
end mReturn
 
 
----- // ------------------- FORMATTING ----------------------
 
-- table // chunksOf :: Int -> [Stringa] -> String[[a]]
const chunksOf = n => {
on table(n, xs)
// xs split into sublists of length n.
-- A list of strings formatted as
// The last sublist will be short if n
-- right-justified rows of n columns.
// does not evenly divide the length of xs .
set vs to map(my str, xs)
set w to length ofconst lastgo item= ofxs vs=> {
const chunk = xs.slice(0, n);
unlines(map(my unwords, ¬
chunksOf(n, map(justifyRight(w, space), vs))))
end table
 
return 0 < chunk.length ? (
[chunk].concat(
go(xs.slice(n))
)
) : [];
};
 
return go;
-- chunksOf :: Int -> [a] -> [[a]]
};
on chunksOf(k, xs)
script
on go(ys)
set ab to splitAt(k, ys)
set a to item 1 of ab
if {} ≠ a then
{a} & go(item 2 of ab)
else
a
end if
end go
end script
result's go(xs)
end chunksOf
 
 
-- justifyRight // compose (<<<) :: Int(b -> c) -> (a -> Charb) -> Stringa -> Stringc
const compose = (...fs) =>
on justifyRight(n, cFiller)
// A function defined by the right-to-left
script
// composition of all the functions in fs.
on |λ|(txt)
if n > length of txt thenfs.reduce(
(f, g) => x text -n thru -1 of=> f(g(replicate(n, cFillerx) as text) & txt),
elsex => x
txt);
end if
end |λ|
end script
end justifyRight
 
 
-- map // flip :: (a -> b -> c) -> [b -> a] -> [b]c
const flip = op =>
on map(f, xs)
// The binary function op with
-- The list obtained by applying f
-- to each element of// xsits arguments reversed.
1 < op.length ? (
tell mReturn(f)
set lng to length of(a, xsb) => op(b, a)
set) lst: to(x {}=> y => op(y)(x));
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
 
 
// intercalate :: String -> [String] -> String
-- Egyptian multiplication - progressively doubling a list, appending
const intercalate = s =>
-- stages of doubling to an accumulator where needed for binary
// The concatenation of xs
-- assembly of a target length
// interspersed with copies of s.
-- replicate :: Int -> String -> String
xs => xs.join(s);
on replicate(n, s)
-- Egyptian multiplication - progressively doubling a list,
-- appending stages of doubling to an accumulator where needed
-- for binary assembly of a target length
script p
on |λ|({n})
n ≤ 1
end |λ|
end script
script f
on |λ|({n, dbl, out})
if (n mod 2) > 0 then
set d to out & dbl
else
set d to out
end if
{n div 2, dbl & dbl, d}
end |λ|
end script
set xs to |until|(p, f, {n, s, ""})
item 2 of xs & item 3 of xs
end replicate
 
 
-- splitAt // justifyRight :: Int -> [a]Char -> ([a],String -> [a])String
const justifyRight = n =>
on splitAt(n, xs)
if n > 0 and// nThe <string lengths, ofpreceded xsby thenenough padding (with
if// classthe ofcharacter xsc) isto textreach thenthe string length n.
c => s => {itemsBoolean(s) 1? thru n of xs as text, ¬(
items s.padStart(n, + 1c) thru -1 of xs as text}
else) : "";
{items 1 thru n of xs, items (n + 1) thru -1 of xs}
end if
else
if n < 1 then
{{}, xs}
else
{xs, {}}
end if
end if
end splitAt
 
 
-- str // maximum :: Ord a => [a] -> Stringa
const maximum = xs => (
on str(x)
// The largest value in a non-empty list.
x as string
ys => 0 < ys.length ? (
end str
ys.slice(1).reduce(
(a, y) => y > a ? (
y
) : a, ys[0]
)
) : undefined
)(xs);
 
 
-- unlines // table :: [String] -> String
// (Int -> Char -> String -> String) ->
on unlines(xs)
// [[String]] -> String
-- A single string formed by the intercalation
const table = gap =>
-- of a list of strings with the newline character.
// A tabulation of rows of string values,
set {dlm, my text item delimiters} to ¬
{my// textwith itema delimiters,specified linefeed}gap between columns,
// and choice of cell alignment function
set s to xs as text
// (justifyLeft | center | justifyRight)
set my text item delimiters to dlm
alignment => rows => {
s
const
end unlines
colWidths = transpose(rows).map(
row => maximum(row.map(x => x.length))
);
 
return rows.map(
compose(
intercalate(gap),
zipWith(
flip(alignment)(" ")
)(colWidths)
)
).join("\n");
};
 
-- until :: (a -> Bool) -> (a -> a) -> a -> a
on |until|(p, f, x)
set v to x
set mp to mReturn(p)
set mf to mReturn(f)
repeat until mp's |λ|(v)
set v to mf's |λ|(v)
end repeat
v
end |until|
 
// transpose :: [[a]] -> [[a]]
const transpose = rows => {
// If any rows are shorter than those that follow,
// their elements are skipped:
// > transpose [[10,11],[20],[],[30,31,32]]
// == [[10,20,30],[11,31],[32]]
const go = xss =>
0 < xss.length ? (() => {
const
h = xss[0],
t = xss.slice(1);
 
return 0 < h.length ? [
-- unwords :: [String] -> String
[h[0]].concat(t.reduce(
on unwords(xs)
(a, xs) => a.concat(
set {dlm, my text item delimiters} to ¬
0 < xs.length ? (
{my text item delimiters, space}
[xs[0]]
set s to xs as text
) : []
set my text item delimiters to dlm
),
return s
[]
end unwords</lang>
))
].concat(go([h.slice(1)].concat(
t.map(xs => xs.slice(1))
))) : go(t);
})() : [];
 
return go(rows);
};
 
 
// zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
const zipWith = f =>
// A list constructed by zipping with a
// custom function, rather than with the
// default tuple constructor.
xs => ys => xs.map(
(x, i) => f(x)(ys[i])
).slice(
0, Math.min(xs.length, ys.length)
);
 
// MAIN ---
return main();
})();</lang>
{{Out}}
<pre> 0 1 9 36 100
9,655

edits