Sum of first n cubes: Difference between revisions

Content added Content deleted
(→‎{{header|AppleScript}}: Replaced a map-accumulation with a scanning accumulation.)
Line 57: Line 57:
1071225 1168561 1272384 1382976 1500625</pre>
1071225 1168561 1272384 1382976 1500625</pre>
=={{header|AppleScript}}==
=={{header|AppleScript}}==
<lang applescript>(() => {
<lang applescript>------------------- SUM OF FIRST N CUBES -----------------
"use strict";


-- sumsOfFirstNCubes :: Int -> [Int]
// -------------- SUM OF FIRST N CUBES ---------------
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 ------------------------


-- enumFromTo :: Int -> Int -> [Int]
// --------------------- GENERIC ---------------------
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);


-- mReturn :: First-class m => (a -> b) -> m (a -> b)
return [v, a[1].concat(v)];
on mReturn(f)
}, [startValue, [startValue]])[1];
-- 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 --------------------
------------------------ FORMATTING ----------------------


// chunksOf :: Int -> [a] -> [[a]]
-- table :: Int -> [String] -> String
on table(n, xs)
const chunksOf = n => {
-- A list of strings formatted as
// xs split into sublists of length n.
-- right-justified rows of n columns.
// The last sublist will be short if n
set vs to map(my str, xs)
// does not evenly divide the length of xs .
const go = xs => {
set w to length of last item of vs
unlines(map(my unwords, ¬
const chunk = xs.slice(0, n);
chunksOf(n, map(justifyRight(w, space), vs))))
end table


return 0 < chunk.length ? (
[chunk].concat(
go(xs.slice(n))
)
) : [];
};


-- chunksOf :: Int -> [a] -> [[a]]
return go;
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




// compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
-- justifyRight :: Int -> Char -> String -> String
on justifyRight(n, cFiller)
const compose = (...fs) =>
script
// A function defined by the right-to-left
on |λ|(txt)
// composition of all the functions in fs.
fs.reduce(
if n > length of txt then
(f, g) => x => f(g(x)),
text -n thru -1 of ((replicate(n, cFiller) as text) & txt)
x => x
else
);
txt
end if
end |λ|
end script
end justifyRight




// flip :: (a -> b -> c) -> b -> a -> c
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
const flip = op =>
-- The list obtained by applying f
// The binary function op with
// its arguments reversed.
-- to each element of xs.
tell mReturn(f)
1 < op.length ? (
(a, b) => op(b, a)
set lng to length of xs
) : (x => y => op(y)(x));
set lst to {}
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




-- Egyptian multiplication - progressively doubling a list, appending
// intercalate :: String -> [String] -> String
-- stages of doubling to an accumulator where needed for binary
const intercalate = s =>
-- assembly of a target length
// The concatenation of xs
-- replicate :: Int -> String -> String
// interspersed with copies of s.
on replicate(n, s)
xs => xs.join(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




// justifyRight :: Int -> Char -> String -> String
-- splitAt :: Int -> [a] -> ([a], [a])
on splitAt(n, xs)
const justifyRight = n =>
// The string s, preceded by enough padding (with
if n > 0 and n < length of xs then
// the character c) to reach the string length n.
if class of xs is text then
c => s => Boolean(s) ? (
{items 1 thru n of xs as text, ¬
s.padStart(n, c)
items (n + 1) 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




// maximum :: Ord a => [a] -> a
-- str :: a -> String
on str(x)
const maximum = xs => (
x as string
// The largest value in a non-empty list.
end str
ys => 0 < ys.length ? (
ys.slice(1).reduce(
(a, y) => y > a ? (
y
) : a, ys[0]
)
) : undefined
)(xs);




// table :: String ->
-- unlines :: [String] -> String
on unlines(xs)
// (Int -> Char -> String -> String) ->
-- A single string formed by the intercalation
// [[String]] -> String
-- of a list of strings with the newline character.
const table = gap =>
set {dlm, my text item delimiters} to ¬
// A tabulation of rows of string values,
// with a specified gap between columns,
{my text item delimiters, linefeed}
set s to xs as text
// and choice of cell alignment function
set my text item delimiters to dlm
// (justifyLeft | center | justifyRight)
s
alignment => rows => {
end unlines
const
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);


-- unwords :: [String] -> String
return 0 < h.length ? [
on unwords(xs)
[h[0]].concat(t.reduce(
set {dlm, my text item delimiters} to ¬
(a, xs) => a.concat(
{my text item delimiters, space}
0 < xs.length ? (
set s to xs as text
[xs[0]]
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}}
{{Out}}
<pre> 0 1 9 36 100
<pre> 0 1 9 36 100
Retrieved from "https://rosettacode.org/wiki/Sum_of_first_n_cubes"