% crochet local singleton module; // -- Folding local abstract maybe; local type some(global value) is maybe; local singleton no-value is maybe; local singleton foldable with command combine: no-value and: X with: F = new some(X); command combine: (X is some) and: Y with: F = new some(F(X value, Y)); command combine-right: X and: no-value with: F = new some(X); command combine-right: X and: (Y is some) with: F = new some(F(X, Y value)); end local type foldable-test(a, b, c); implement foldable-collection for foldable-test; command foldable-test fold-from: I with: F = F(F(F(I, self.a), self.b), self.c); command foldable-test fold-right-from: I with: F = F(self.a, F(self.b, F(self.c, I))); local type foldable-test1(a); implement foldable-collection for foldable-test1; command foldable-test1 fold-from: I with: F = F(I, self.a); command foldable-test1 fold-right-from: I with: F = F(self.a, I); /// Convenience for [command:_ fold-from: _ with: _] that uses a value from the collection /// as the initial state. command (X has foldable-collection) fold-with: Computation do X fold-from: no-value with: (foldable combine: _ and: _ with: Computation) | value; test assert (new foldable-test(1, 2, 3) fold-with: { A, B in [A, B] }) === [[1, 2], 3]; assert (new foldable-test1(1) fold-with: { A, B in [A, B] }) === 1; end /// Convenience for [command:_ fold-right-from: _ with: _] that uses a value from the /// collection as the initial state. command (X has foldable-collection) fold-right-with: Computation do X fold-right-from: no-value with: (foldable combine-right: _ and: _ with: Computation) | value; test assert (new foldable-test(1, 2, 3) fold-right-with: { A, B in [A, B] }) === [1, [2, 3]]; assert (new foldable-test1(1) fold-with: { A, B in [A, B] }) === 1; end /// True if the given `Predicate` holds for at least one of the items in /// the collection. command (X has foldable-collection) some: (Predicate is (A -> boolean)) -> boolean do X fold-from: false with: { A, B in A or Predicate(B) }; test assert ([] some: (_ === 2)) === false; assert ([1] some: (_ === 2)) === false; assert ([1, 2, 3] some: (_ === 2)) === true; assert ([1, 2, 3, 2, 1] some: (_ === 2)) === true; assert ([1, 3, 1, 3, 1] some: (_ === 2)) === false; end /// True if the given `Predicate` holds for all of the items in the /// collection. command (X has foldable-collection) all: (Predicate is (A -> boolean)) -> boolean do X fold-from: true with: { A, B in A and Predicate(B) }; test assert ([] all: (_ > 3)) === true; assert ([1] all: (_ > 3)) === false; assert ([1, 2, 3] all: (_ > 3)) === false; assert ([4, 5, 6] all: (_ > 3)) === true; end /// True if all of the items in the collection are `true`. command (X has foldable-collection) all-true -> boolean do X fold-from: true with: (_ and _); test assert ([] all-true) === true; assert ([true, true] all-true) === true; assert ([false] all-true) === false; assert ([false, true, false] all-true) === false; end /// True if at least one of the items in the collection is `true`. command (X has foldable-collection) some-true -> boolean do X fold-from: false with: (_ or _); test assert ([] some-true) === false; assert ([true, true] some-true) === true; assert ([false] some-true) === false; assert ([false, true, false] some-true) === true; end /// The arithmetic sum of all items in the collection. Every item must /// implement [trait:arithmetic]. command (X has foldable-collection) sum do X fold-from: 0 with: (_ + _); test assert ([] sum) === 0; assert ([1, 2, 3, 4] sum) === (0 + 1 + 2 + 3 + 4); end /// The arithmetic product of all items in the collection. Every item must /// implement [trait:arithmetic]. command (X has foldable-collection) product do X fold-from: 1 with: (_ * _); test assert ([] product) === 1; assert ([1, 2, 3, 4] product) === (1 * 1 * 2 * 3 * 4); end /// The average of all items in the collection. Every item must implement /// [trait:arithmetic]. command (X has foldable-collection, countable-container) average -> float requires non-empty :: not X is-empty do X sum / X count; test assert ([3] average) === 3.0; assert ([1, 2, 3, 4, 5, 6, 7] average) === 4.0; assert ([3, 5, 8, 1, 5] average) === 4.4; end /// The highest value in the collection. All values must have a [trait:total-ordering]. command (X has foldable-collection) maximum requires non-empty :: not X is-empty do X fold-with: (greater-of: _ and: _) test assert ([1] maximum) === 1; assert ([1, 0, 2] maximum) === 2; assert ([-3, 5, 2, -5] maximum) === 5; end /// The lowest value in the collection. All values must have a [trait:total-ordering]. command (X has foldable-collection) minimum requires non-empty :: not X is-empty do X fold-with: (lesser-of: _ and: _) test assert ([1] minimum) === 1; assert ([1, 0, 2] minimum) === 0; assert ([-3, 5, 2, -5] minimum) === -5; end /// Pairs each value in the collection with its position (as a positive integer). command (X has foldable-collection, appendable-sequence) enumerate do let Result = X fold-from: [index -> 1, result -> X empty] with: { State, Value in [ index -> State.index + 1, result -> State.result append: (#indexed index: State.index value: Value), ] }; Result.result; test assert ([] enumerate) === []; assert (["a", "b", "c"] enumerate) === [ #indexed index: 1 value: "a", #indexed index: 2 value: "b", #indexed index: 3 value: "c", ]; end // -- Zipping /// True if two zip-pair values are equal. command zip-pair === (That is zip-pair) = (self first === That first) and (self second === That second); /// Combines every element of `X` with the elements of `That`, then produces /// a new collection of these pairs. command (X has zippable-collection) zip: (That has zippable-collection) = self zip: That with: { A, B in new zip-pair(A, B) } test assert ([] zip: []) === []; assert ([1] zip: [2]) === [ new zip-pair(1, 2), ]; assert ([1, 2, 3] zip: [4, 5, 6]) === [ new zip-pair(1, 4), new zip-pair(2, 5), new zip-pair(3, 6), ]; assert ([1, 2] zip: ["a", "b"]) === [ new zip-pair(1, "a"), new zip-pair(2, "b"), ]; end // -- Filtering /// Yields a new collection containing only elements that don't satisfy /// the given `Predicate`. command (X has filterable-collection) remove-if: (Predicate is (A -> boolean)) do X keep-if: { X in not Predicate(X) }; test assert ([] remove-if: (_ > 2)) === []; assert ([1, 2, 3, 2, 1] remove-if: (_ > 2)) === [1, 2, 2, 1]; assert ([1, 5, 3, 1, 6, 2] remove-if: (_ > 2)) === [1, 1, 2]; end /// Partitions the collection into two: one containing elements that satisfy /// the `Predicate`, and one containing elements that don't satisfy it. command (X has filterable-collection) partition-by: (Predicate is (A -> boolean)) do new partition-pair(X keep-if: Predicate, X remove-if: Predicate); test let P = [1, 2, 3, 4, 5] partition-by: (_ < 3); assert P satisfying === [1, 2]; assert P not-satisfying === [3, 4, 5]; end // -- Grouping and statistics /// Returns a map grouping items in the collection according to the given /// classifier function. command (X has foldable-collection) group-by: (Classifier is (A -> K)) -> map> do X fold-from: #map empty with: (module group-by: Classifier state: _ value: _); test let N = [1, 2, 3, 4, 5, 6]; let Classify = { X in condition when (X % 2) === 0 => "even"; when (X % 2) =/= 0 => "odd"; end }; assert ([] group-by: Classify) === #map empty; assert ([1, 2, 3, 4, 5, 6] group-by: Classify) === (#map from: [even -> [2, 4, 6], odd -> [1, 3, 5]]); assert ([1, 3, 5] group-by: Classify) === (#map from: [odd -> [1, 3, 5]]); end command module group-by: Classifier state: State value: Value do let Key = Classifier(Value); State at: Key default: [Value] update: (_ append: Value); end /// Returns a map where each value is associated with the number of times /// it happens in the collection. command (X has foldable-collection) frequencies -> map do X fold-from: #map empty with: { M, V in M at: V default: 1 update: (_ + 1) }; test assert ([] frequencies) === #map empty; assert ([1, 2, 1, 1, 3, 2] frequencies) === (#map empty | at: 1 put: 3 | at: 2 put: 2 | at: 3 put: 1); end